diff -Nru haskell-hspec-1.11.0/debian/changelog haskell-hspec-2.1.5/debian/changelog --- haskell-hspec-1.11.0/debian/changelog 2014-08-10 18:42:17.000000000 +0000 +++ haskell-hspec-2.1.5/debian/changelog 2015-06-04 09:31:40.000000000 +0000 @@ -1,14 +1,33 @@ -haskell-hspec (1.11.0-1build2) utopic; urgency=medium +haskell-hspec (2.1.5-2build2) wily; urgency=medium * Rebuild for new GHC ABIs. - -- Colin Watson Sun, 10 Aug 2014 19:42:17 +0100 + -- Colin Watson Thu, 04 Jun 2015 10:31:40 +0100 -haskell-hspec (1.11.0-1build1) utopic; urgency=medium +haskell-hspec (2.1.5-2build1) wily; urgency=medium * Rebuild for new GHC ABIs. - -- Colin Watson Sat, 09 Aug 2014 23:38:49 +0200 + -- Colin Watson Mon, 25 May 2015 18:33:15 +0100 + +haskell-hspec (2.1.5-2) unstable; urgency=medium + + * Upload to unstable + + -- Joachim Breitner Mon, 27 Apr 2015 11:50:38 +0200 + +haskell-hspec (2.1.5-1) experimental; urgency=medium + + * New upstream release + + -- Joachim Breitner Thu, 16 Apr 2015 21:44:31 +0200 + +haskell-hspec (1.11.0-2) experimental; urgency=medium + + * Depend on haskell-devscripts 0.9, found in experimental + * Do not depend on transformers, which now comes with GHC + + -- Joachim Breitner Sun, 21 Dec 2014 15:04:38 +0100 haskell-hspec (1.11.0-1) unstable; urgency=medium diff -Nru haskell-hspec-1.11.0/debian/control haskell-hspec-2.1.5/debian/control --- haskell-hspec-1.11.0/debian/control 2014-07-31 11:48:03.000000000 +0000 +++ haskell-hspec-2.1.5/debian/control 2015-04-27 09:45:10.000000000 +0000 @@ -5,41 +5,26 @@ Uploaders: Clint Adams Build-Depends: debhelper (>= 9) , cdbs - , haskell-devscripts (>= 0.8.15) + , haskell-devscripts (>= 0.9) , ghc , ghc-prof - , libghc-tf-random-dev - , libghc-tf-random-prof - , libghc-setenv-dev - , libghc-setenv-prof - , libghc-ansi-terminal-dev (>> 0.5) - , libghc-ansi-terminal-prof - , libghc-hunit-dev (>> 1.2.5) + , libghc-hspec-core-dev (>= 2.1.5) + , libghc-hspec-core-dev (<< 2.1.6) + , libghc-hspec-core-prof + , hspec-discover (>= 2.1.5) + , hspec-discover (<< 2.1.6) + , libghc-hspec-expectations-dev (>= 0.6.1) + , libghc-hspec-expectations-dev (<< 0.6.2) + , libghc-hspec-expectations-prof + , libghc-hunit-dev (>= 1.2.5) , libghc-hunit-prof - , libghc-quickcheck2-dev (>> 2.5.1) + , libghc-quickcheck2-dev (>= 2.5.1) , libghc-quickcheck2-prof - , libghc-quickcheck-io-dev - , libghc-quickcheck-io-prof - , libghc-silently-dev (>> 1.1.1) - , libghc-silently-prof - , libghc-transformers-dev (>> 0.2.2.0) - , libghc-transformers-prof - , libghc-hspec-expectations-dev (>= 0.5.0) - , libghc-hspec-expectations-dev (<< 0.6.1) - , libghc-hspec-expectations-prof - , libghc-async-dev - , libghc-async-prof Build-Depends-Indep: ghc-doc - , libghc-tf-random-doc - , libghc-setenv-doc - , libghc-ansi-terminal-doc + , libghc-hspec-core-doc + , libghc-hspec-expectations-doc , libghc-hunit-doc , libghc-quickcheck2-doc - , libghc-quickcheck-io-doc - , libghc-silently-doc - , libghc-transformers-doc - , libghc-hspec-expectations-doc - , libghc-async-doc Standards-Version: 3.9.5 Homepage: http://hackage.haskell.org/package/hspec Vcs-Darcs: http://darcs.debian.org/pkg-haskell/haskell-hspec @@ -50,6 +35,8 @@ Depends: ${haskell:Depends} , ${shlibs:Depends} , ${misc:Depends} + , hspec-discover (>= 2.1.5) + , hspec-discover (<< 2.1.6) Recommends: ${haskell:Recommends} Suggests: ${haskell:Suggests} Provides: ${haskell:Provides} diff -Nru haskell-hspec-1.11.0/debian/patches/no-hspec-discover haskell-hspec-2.1.5/debian/patches/no-hspec-discover --- haskell-hspec-1.11.0/debian/patches/no-hspec-discover 1970-01-01 00:00:00.000000000 +0000 +++ haskell-hspec-2.1.5/debian/patches/no-hspec-discover 2015-04-27 09:45:10.000000000 +0000 @@ -0,0 +1,16 @@ +Do not depend on hspec-discover (the haskell library), as that is empty +anyways. We ensure that the hspec-discover binary is available via +control/debian. + +Index: hspec-2.1.5/hspec.cabal +=================================================================== +--- hspec-2.1.5.orig/hspec.cabal 2015-04-16 21:38:14.701740958 +0200 ++++ hspec-2.1.5/hspec.cabal 2015-04-16 21:38:42.110995831 +0200 +@@ -42,7 +42,6 @@ + build-depends: + base == 4.* + , hspec-core == 2.1.5 +- , hspec-discover == 2.1.5 + , hspec-expectations == 0.6.1.* + , transformers >= 0.2.2.0 + , QuickCheck >= 2.5.1 diff -Nru haskell-hspec-1.11.0/debian/patches/series haskell-hspec-2.1.5/debian/patches/series --- haskell-hspec-1.11.0/debian/patches/series 1970-01-01 00:00:00.000000000 +0000 +++ haskell-hspec-2.1.5/debian/patches/series 2015-04-27 09:45:10.000000000 +0000 @@ -0,0 +1 @@ +no-hspec-discover diff -Nru haskell-hspec-1.11.0/debian/rules haskell-hspec-2.1.5/debian/rules --- haskell-hspec-1.11.0/debian/rules 2012-10-21 10:09:23.000000000 +0000 +++ haskell-hspec-2.1.5/debian/rules 2015-04-27 09:45:10.000000000 +0000 @@ -2,7 +2,3 @@ include /usr/share/cdbs/1/rules/debhelper.mk include /usr/share/cdbs/1/class/hlibrary.mk - -install/libghc-hspec-dev:: debian/tmp-inst-ghc - install -d debian/libghc-hspec-dev/usr/bin - cp -av debian/tmp-inst-ghc/usr/bin/* debian/libghc-hspec-dev/usr/bin diff -Nru haskell-hspec-1.11.0/example/Spec.hs haskell-hspec-2.1.5/example/Spec.hs --- haskell-hspec-1.11.0/example/Spec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/example/Spec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,16 +0,0 @@ -module Main (main, spec) where - -import Test.Hspec -import Test.QuickCheck - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "reverse" $ do - it "reverses a list" $ do - reverse [1 :: Int, 2, 3] `shouldBe` [3, 2, 1] - - it "gives the original list, if applied twice" $ property $ - \xs -> (reverse . reverse) xs == (xs :: [Int]) diff -Nru haskell-hspec-1.11.0/hspec.cabal haskell-hspec-2.1.5/hspec.cabal --- haskell-hspec-1.11.0/hspec.cabal 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec.cabal 2015-03-21 14:58:23.000000000 +0000 @@ -1,5 +1,5 @@ name: hspec -version: 1.11.0 +version: 2.1.5 license: MIT license-file: LICENSE copyright: (c) 2011-2014 Simon Hengel, @@ -7,175 +7,75 @@ (c) 2011 Greg Weber maintainer: Simon Hengel build-type: Simple -cabal-version: >= 1.8 +cabal-version: >= 1.10 category: Testing stability: experimental bug-reports: https://github.com/hspec/hspec/issues homepage: http://hspec.github.io/ -synopsis: Behavior-Driven Development for Haskell -description: Behavior-Driven Development for Haskell +synopsis: A Testing Framework for Haskell +description: Hspec is a testing framework for Haskell. It is inspired by + the Ruby library RSpec. Some of Hspec's distinctive features + are: . - Hspec is roughly based on the Ruby library RSpec. However, - Hspec is just a framework for running HUnit and QuickCheck - tests. Compared to other options, it provides a much nicer - syntax that makes tests very easy to read. + * a friendly DSL for defining tests + . + * integration with QuickCheck, SmallCheck, and HUnit + . + * parallel test execution + . + * automatic discovery of test files . The Hspec Manual is at . extra-source-files: changelog --- find hspec-discover/test-data/ -type f - hspec-discover/test-data/nested-spec/FooSpec.hs - hspec-discover/test-data/nested-spec/Foo/Bar/BazSpec.hs - hspec-discover/test-data/nested-spec/Foo/BarSpec.hs - hspec-discover/test-data/empty-dir/Foo/Bar/Baz/.placeholder - source-repository head type: git location: https://github.com/hspec/hspec -Library +library ghc-options: -Wall hs-source-dirs: src build-depends: - base == 4.* - , random - , tf-random - , setenv - , ansi-terminal >= 0.5 - , time - , transformers >= 0.2.2.0 - , deepseq - , HUnit >= 1.2.5 - , QuickCheck >= 2.5.1 - , quickcheck-io - , hspec-expectations >= 0.5.0 && < 0.6.1 - , async >= 2 + base == 4.* + , hspec-core == 2.1.5 + , hspec-discover == 2.1.5 + , hspec-expectations == 0.6.1.* + , transformers >= 0.2.2.0 + , QuickCheck >= 2.5.1 + , HUnit >= 1.2.5 exposed-modules: Test.Hspec - Test.Hspec.Core Test.Hspec.Runner Test.Hspec.Formatters - Test.Hspec.HUnit Test.Hspec.QuickCheck - other-modules: - Test.Hspec.Util - Test.Hspec.Compat - Test.Hspec.Core.Type - Test.Hspec.Core.QuickCheckUtil - Test.Hspec.Config - Test.Hspec.Options - Test.Hspec.FailureReport - Test.Hspec.Runner.Eval - Test.Hspec.Runner.Tree - Test.Hspec.Formatters.Internal - Test.Hspec.Timer + Test.Hspec.Discover + Test.Hspec.Core + Test.Hspec.HUnit + default-language: Haskell2010 test-suite spec type: exitcode-stdio-1.0 - hs-source-dirs: - src, test - main-is: - Spec.hs - other-modules: - Mock - Helper - Test.HspecSpec - Test.Hspec.CompatSpec - Test.Hspec.Core.QuickCheckUtilSpec - Test.Hspec.Core.TypeSpec - Test.Hspec.FailureReportSpec - Test.Hspec.FormattersSpec - Test.Hspec.HUnitSpec - Test.Hspec.OptionsSpec - Test.Hspec.QuickCheckSpec - Test.Hspec.RunnerSpec - Test.Hspec.TimerSpec - Test.Hspec.UtilSpec ghc-options: - -Wall -Werror - build-depends: - base == 4.* - , random - , tf-random - , setenv - , silently >= 1.2.4 - , ansi-terminal - , time - , transformers - , deepseq - , HUnit - , QuickCheck - , quickcheck-io - , hspec-expectations - , async - - , hspec-meta >= 1.9.1 - , process - , ghc-paths - -test-suite doctests - main-is: - doctests.hs - type: - exitcode-stdio-1.0 - ghc-options: - -Wall -Werror -threaded + -Wall hs-source-dirs: test - build-depends: - base == 4.* - , doctest >= 0.9.4.1 - -test-suite example - type: - exitcode-stdio-1.0 main-is: Spec.hs - hs-source-dirs: - example - ghc-options: - -Wall -Werror - build-depends: - base == 4.* - , hspec - , QuickCheck - --- hspec-discover -executable hspec-discover - ghc-options: - -Wall - hs-source-dirs: - hspec-discover/src - main-is: - Main.hs other-modules: - Run - Config + Helper + HelperSpec + Test.Hspec.DiscoverSpec build-depends: - base == 4.* - , filepath - , directory + base == 4.* + , hspec-core + , hspec -test-suite hspec-discover-spec - type: - exitcode-stdio-1.0 - ghc-options: - -Wall -Werror - hs-source-dirs: - hspec-discover/src - , hspec-discover/test - main-is: - Spec.hs - other-modules: - RunSpec - ConfigSpec - build-depends: - base == 4.* - , filepath , directory - , hspec-meta + , stringbuilder + , hspec-meta >= 1.12 + default-language: Haskell2010 diff -Nru haskell-hspec-1.11.0/hspec-discover/src/Config.hs haskell-hspec-2.1.5/hspec-discover/src/Config.hs --- haskell-hspec-1.11.0/hspec-discover/src/Config.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec-discover/src/Config.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,43 +0,0 @@ -module Config ( - Config (..) -, defaultConfig -, parseConfig -, usage -) where - -import Data.Maybe -import System.Console.GetOpt - -data Config = Config { - configNested :: Bool -, configFormatter :: Maybe String -, configNoMain :: Bool -} deriving (Eq, Show) - -defaultConfig :: Config -defaultConfig = Config False Nothing False - -options :: [OptDescr (Config -> Config)] -options = [ - Option [] ["nested"] (NoArg $ \c -> c {configNested = True}) "" - , Option [] ["formatter"] (ReqArg (\s c -> c {configFormatter = Just s}) "FORMATTER") "" - , Option [] ["no-main"] (NoArg $ \c -> c {configNoMain = True}) "" - ] - -usage :: String -> String -usage prog = "\nUsage: " ++ prog ++ " SRC CUR DST [--formatter=FORMATTER] [--no-main]\n" - -parseConfig :: String -> [String] -> Either String Config -parseConfig prog args = case getOpt Permute options args of - (opts, [], []) -> let - c = (foldl (flip id) defaultConfig opts) - in - if (configNoMain c && isJust (configFormatter c)) - then - formatError "option `--formatter=' does not make sense with `--no-main'\n" - else - Right c - (_, _, err:_) -> formatError err - (_, arg:_, _) -> formatError ("unexpected argument `" ++ arg ++ "'\n") - where - formatError err = Left (prog ++ ": " ++ err ++ usage prog) diff -Nru haskell-hspec-1.11.0/hspec-discover/src/Main.hs haskell-hspec-2.1.5/hspec-discover/src/Main.hs --- haskell-hspec-1.11.0/hspec-discover/src/Main.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec-discover/src/Main.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,8 +0,0 @@ -module Main (main) where - -import System.Environment - -import Run (run) - -main :: IO () -main = getArgs >>= run diff -Nru haskell-hspec-1.11.0/hspec-discover/src/Run.hs haskell-hspec-2.1.5/hspec-discover/src/Run.hs --- haskell-hspec-1.11.0/hspec-discover/src/Run.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec-discover/src/Run.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,132 +0,0 @@ -{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, OverloadedStrings #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} --- | A preprocessor that finds and combines specs. -module Run ( - run - --- exported for testing -, importList -, fileToSpec -, findSpecs -, getFilesRecursive -, driverWithFormatter -, moduleName -) where -import Control.Monad -import Control.Applicative -import Data.List -import Data.Char -import Data.Maybe -import Data.String -import System.Environment -import System.Exit -import System.IO -import System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist) -import System.FilePath hiding (combine) - -import Config - -instance IsString ShowS where - fromString = showString - -type Spec = String - -run :: [String] -> IO () -run args_ = do - name <- getProgName - case args_ of - src : _ : dst : args -> case parseConfig name args of - Left err -> do - hPutStrLn stderr err - exitFailure - Right c -> do - when (configNested c) (hPutStrLn stderr "hspec-discover: WARNING - The `--nested' flag is deprecated and will be removed in a future release!") - specs <- findSpecs src - writeFile dst (mkSpecModule src c specs) - _ -> do - hPutStrLn stderr (usage name) - exitFailure - -mkSpecModule :: FilePath -> Config -> [Spec] -> String -mkSpecModule src c nodes = - ( "{-# LINE 1 " . shows src . " #-}" - . showString ("module " ++ module_ ++" where\n") - . importList nodes - . maybe driver (driverWithFormatter (null nodes)) (configFormatter c) - . formatSpecs nodes - ) "\n" - where - driver = - showString "import Test.Hspec\n" - . case configNoMain c of - False -> - showString "main :: IO ()\n" - . showString "main = hspec $ " - True -> - showString "spec :: Spec\n" - . showString "spec = " - module_ = if configNoMain c then pathToModule src else "Main" - pathToModule f = let - fileName = last $ splitDirectories f - m:ms = takeWhile (/='.') fileName - in - toUpper m:ms - - -driverWithFormatter :: Bool -> String -> ShowS -driverWithFormatter isEmpty f = - (if isEmpty then id else "import Test.Hspec\n") - . showString "import Test.Hspec.Runner\n" - . showString "import qualified " . showString (moduleName f) . showString "\n" - . showString "main :: IO ()\n" - . showString "main = hspecWithFormatter " . showString f . showString " $ " - -moduleName :: String -> String -moduleName = reverse . dropWhile (== '.') . dropWhile (/= '.') . reverse - --- | Generate imports for a list of specs. -importList :: [Spec] -> ShowS -importList = foldr (.) "" . map f - where - f :: Spec -> ShowS - f name = "import qualified " . showString name . "Spec\n" - --- | 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 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 String -fileToSpec f = intercalate "." . reverse <$> case reverse $ splitDirectories f of - x:xs -> case stripSuffix "Spec.hs" x <|> stripSuffix "Spec.lhs" x of - Nothing -> Nothing - Just "" -> Nothing - Just ys -> Just (ys : xs) - _ -> Nothing - where - stripSuffix :: Eq a => [a] -> [a] -> Maybe [a] - stripSuffix suffix str = reverse <$> stripPrefix (reverse suffix) (reverse str) - -getFilesRecursive :: FilePath -> IO [FilePath] -getFilesRecursive baseDir = sort <$> go [] - 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) diff -Nru haskell-hspec-1.11.0/hspec-discover/test/ConfigSpec.hs haskell-hspec-2.1.5/hspec-discover/test/ConfigSpec.hs --- haskell-hspec-1.11.0/hspec-discover/test/ConfigSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec-discover/test/ConfigSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,47 +0,0 @@ -module ConfigSpec (main, spec) where - -import Test.Hspec.Meta - -import Config - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "parseConfig" $ do - let parse = parseConfig "hspec-discover" - - it "recognizes --nested" $ do - parse ["--nested"] `shouldBe` Right (defaultConfig {configNested = True}) - - it "recognizes --formatter" $ do - parse ["--formatter", "someFormatter"] `shouldBe` Right (defaultConfig {configFormatter = Just "someFormatter"}) - - it "recognizes --no-main" $ do - parse ["--no-main"] `shouldBe` Right (defaultConfig {configNoMain = True}) - - it "returns error message on unrecognized option" $ do - parse ["--foo"] `shouldBe` (Left . unlines) [ - "hspec-discover: unrecognized option `--foo'" - , "" - , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER] [--no-main]" - ] - - it "returns error message on unexpected argument" $ do - parse ["foo"] `shouldBe` (Left . unlines) [ - "hspec-discover: unexpected argument `foo'" - , "" - , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER] [--no-main]" - ] - - it "returns error message on --formatter= with --no-main" $ do - parse ["--no-main", "--formatter=foo"] `shouldBe` (Left . unlines) [ - "hspec-discover: option `--formatter=' does not make sense with `--no-main'" - , "" - , "Usage: hspec-discover SRC CUR DST [--formatter=FORMATTER] [--no-main]" - ] - - context "when option is given multiple times" $ do - it "gives the last occurrence precedence" $ do - parse ["--formatter", "foo", "--formatter", "bar"] `shouldBe` Right (defaultConfig {configFormatter = Just "bar"}) diff -Nru haskell-hspec-1.11.0/hspec-discover/test/RunSpec.hs haskell-hspec-2.1.5/hspec-discover/test/RunSpec.hs --- haskell-hspec-1.11.0/hspec-discover/test/RunSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec-discover/test/RunSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,100 +0,0 @@ -module RunSpec (main, spec) where - -import Test.Hspec.Meta - -import Control.Applicative -import System.IO -import System.Directory -import System.FilePath -import Data.List (intercalate, sort) - -import 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 ["hspec-discover/test-data/nested-spec/Spec.hs", "", f] - readFile f `shouldReturn` unlines [ - "{-# LINE 1 \"hspec-discover/test-data/nested-spec/Spec.hs\" #-}module Main where" - , "import qualified Foo.Bar.BazSpec" - , "import qualified Foo.BarSpec" - , "import qualified FooSpec" - , "import Test.Hspec" - , "main :: IO ()" - , "main = hspec $ describe \"Foo.Bar.Baz\" Foo.Bar.BazSpec.spec >> describe \"Foo.Bar\" Foo.BarSpec.spec >> describe \"Foo\" FooSpec.spec" - ] - - it "generates test driver for an empty directory" $ withTempFile $ \f -> do - run ["hspec-discover/test-data/empty-dir/Spec.hs", "", f] - readFile f `shouldReturn` unlines [ - "{-# LINE 1 \"hspec-discover/test-data/empty-dir/Spec.hs\" #-}module Main where" - , "import Test.Hspec" - , "main :: IO ()" - , "main = hspec $ return ()" - ] - - describe "getFilesRecursive" $ do - it "recursively returns all file entries of a given directory" $ do - getFilesRecursive "hspec-discover/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 "Foo" - - it "rejects spec with empty name" $ do - fileToSpec "Spec.hs" `shouldBe` Nothing - - it "works for lhs files" $ do - fileToSpec "FooSpec.lhs" `shouldBe` Just "Foo" - - it "returns Nothing for invalid spec name" $ do - fileToSpec "foo" `shouldBe` Nothing - - context "when path has directory component" $ do - it "converts path to spec name" $ do - fileToSpec ("Foo" "Bar" "BazSpec.hs") `shouldBe` Just "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 "hspec-discover/test-data/nested-spec/Spec.hs" `shouldReturn` ["Foo.Bar.Baz","Foo.Bar","Foo"] - - describe "driverWithFormatter" $ do - it "generates a test driver that uses a custom formatter" $ do - driverWithFormatter False "Some.Module.formatter" "" `shouldBe` intercalate "\n" [ - "import Test.Hspec" - , "import Test.Hspec.Runner" - , "import qualified Some.Module" - , "main :: IO ()" - , "main = hspecWithFormatter Some.Module.formatter $ " - ] - - describe "moduleName" $ do - it "returns the module name of an fully qualified identifier" $ do - moduleName "Some.Module.someId" `shouldBe` "Some.Module" - - describe "importList" $ do - it "generates imports for a list of specs" $ do - importList ["Foo", "Bar"] "" `shouldBe` unlines [ - "import qualified FooSpec" - , "import qualified BarSpec" - ] diff -Nru haskell-hspec-1.11.0/hspec-discover/test/Spec.hs haskell-hspec-2.1.5/hspec-discover/test/Spec.hs --- haskell-hspec-1.11.0/hspec-discover/test/Spec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/hspec-discover/test/Spec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1 +0,0 @@ -{-# OPTIONS_GHC -F -pgmF hspec-meta-discover #-} diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Compat.hs haskell-hspec-2.1.5/src/Test/Hspec/Compat.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Compat.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Compat.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,83 +0,0 @@ -{-# LANGUAGE CPP #-} -module Test.Hspec.Compat ( - showType -, showFullType -, readMaybe -, lookupEnv -, module Data.IORef -#if !MIN_VERSION_base(4,6,0) -, modifyIORef' -#endif -) where - -#if !MIN_VERSION_base(4,3,0) -import Control.Monad.Trans.Error () -- for Monad (Either e) -#endif - -import Data.Typeable (Typeable, typeOf, typeRepTyCon) -import Text.Read -import Data.IORef -import System.Environment - -#if MIN_VERSION_base(4,4,0) -import Data.Typeable.Internal (tyConModule, tyConName) -#endif - -#if !MIN_VERSION_base(4,6,0) -import qualified Text.ParserCombinators.ReadP as P -#endif - -#if !MIN_VERSION_base(4,6,0) --- |Strict version of 'modifyIORef' -modifyIORef' :: IORef a -> (a -> a) -> IO () -modifyIORef' ref f = do - x <- readIORef ref - let x' = f x - x' `seq` writeIORef ref x' - --- | Parse a string using the 'Read' instance. --- Succeeds if there is exactly one valid result. --- A 'Left' value indicates a parse error. -readEither :: Read a => String -> Either String a -readEither s = - case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of - [x] -> Right x - [] -> Left "Prelude.read: no parse" - _ -> Left "Prelude.read: ambiguous parse" - where - read' = - do x <- readPrec - lift P.skipSpaces - return x - --- | Parse a string using the 'Read' instance. --- Succeeds if there is exactly one valid result. -readMaybe :: Read a => String -> Maybe a -readMaybe s = case readEither s of - Left _ -> Nothing - Right a -> Just a - --- | Return the value of the environment variable @var@, or @Nothing@ if --- there is no such value. --- --- For POSIX users, this is equivalent to 'System.Posix.Env.getEnv'. -lookupEnv :: String -> IO (Maybe String) -lookupEnv k = lookup k `fmap` getEnvironment -#endif - -showType :: Typeable a => a -> String -showType a = let t = typeRepTyCon (typeOf a) in -#if MIN_VERSION_base(4,4,0) - show t -#else - (reverse . takeWhile (/= '.') . reverse . show) t -#endif - - -showFullType :: Typeable a => a -> String -showFullType a = let t = typeRepTyCon (typeOf a) in -#if MIN_VERSION_base(4,4,0) - tyConModule t ++ "." ++ tyConName t -#else - show t -#endif diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Config.hs haskell-hspec-2.1.5/src/Test/Hspec/Config.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Config.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Config.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,136 +0,0 @@ -module Test.Hspec.Config ( - Config (..) -, defaultConfig -, getConfig -, configAddFilter -, configQuickCheckArgs -) where - -import Control.Applicative -import Data.List -import Data.Maybe -import System.IO -import System.Exit -import qualified Test.QuickCheck as QC -import Test.Hspec.Formatters - -import Test.Hspec.Util -import Test.Hspec.Options -import Test.Hspec.FailureReport -import Test.Hspec.Core.QuickCheckUtil (mkGen) - -data Config = Config { - configDryRun :: Bool -, configPrintCpuTime :: Bool -, configFastFail :: Bool - --- | --- A predicate that is used to filter the spec before it is run. Only examples --- that satisfy the predicate are run. -, configFilterPredicate :: Maybe (Path -> Bool) -, configQuickCheckSeed :: Maybe Integer -, configQuickCheckMaxSuccess :: Maybe Int -, configQuickCheckMaxDiscardRatio :: Maybe Int -, configQuickCheckMaxSize :: Maybe Int -, configSmallCheckDepth :: Int -, configColorMode :: ColorMode -, configFormatter :: Formatter -, configHtmlOutput :: Bool -, configHandle :: Either Handle FilePath -} - -defaultConfig :: Config -defaultConfig = Config { - configDryRun = False -, configPrintCpuTime = False -, configFastFail = False -, configFilterPredicate = Nothing -, configQuickCheckSeed = Nothing -, configQuickCheckMaxSuccess = Nothing -, configQuickCheckMaxDiscardRatio = Nothing -, configQuickCheckMaxSize = Nothing -, configSmallCheckDepth = 5 -, configColorMode = ColorAuto -, configFormatter = specdoc -, configHtmlOutput = False -, configHandle = Left stdout -} - --- | Add a filter predicate to config. If there is already a filter predicate, --- then combine them with `||`. -configAddFilter :: (Path -> Bool) -> Config -> Config -configAddFilter p1 c = c { - configFilterPredicate = Just p1 `filterOr` configFilterPredicate c - } - -filterOr :: Maybe (Path -> Bool) -> Maybe (Path -> Bool) -> Maybe (Path -> Bool) -filterOr p1_ p2_ = case (p1_, p2_) of - (Just p1, Just p2) -> Just $ \path -> p1 path || p2 path - _ -> p1_ <|> p2_ - -mkConfig :: Maybe FailureReport -> Options -> Config -mkConfig mFailureReport opts = Config { - configDryRun = optionsDryRun opts - , configPrintCpuTime = optionsPrintCpuTime opts - , configFastFail = optionsFastFail opts - , configFilterPredicate = matchFilter `filterOr` rerunFilter - , configQuickCheckSeed = mSeed - , configQuickCheckMaxSuccess = mMaxSuccess - , configQuickCheckMaxDiscardRatio = mMaxDiscardRatio - , configQuickCheckMaxSize = mMaxSize - , configSmallCheckDepth = fromMaybe (configSmallCheckDepth defaultConfig) (optionsDepth opts) - , configColorMode = optionsColorMode opts - , configFormatter = optionsFormatter opts - , configHtmlOutput = optionsHtmlOutput opts - , configHandle = maybe (configHandle defaultConfig) Right (optionsOutputFile opts) - } - where - - mSeed = optionsSeed opts <|> (failureReportSeed <$> mFailureReport) - mMaxSuccess = optionsMaxSuccess opts <|> (failureReportMaxSuccess <$> mFailureReport) - mMaxSize = optionsMaxSize opts <|> (failureReportMaxSize <$> mFailureReport) - mMaxDiscardRatio = optionsMaxDiscardRatio opts <|> (failureReportMaxDiscardRatio <$> mFailureReport) - - matchFilter = case optionsMatch opts of - [] -> Nothing - xs -> Just $ foldl1' (\p0 p1 path -> p0 path || p1 path) (map filterPredicate xs) - - rerunFilter = flip elem . failureReportPaths <$> mFailureReport - -configQuickCheckArgs :: Config -> QC.Args -configQuickCheckArgs c = qcArgs - where - qcArgs = ( - maybe id setSeed (configQuickCheckSeed c) - . maybe id setMaxDiscardRatio (configQuickCheckMaxDiscardRatio c) - . maybe id setMaxSize (configQuickCheckMaxSize c) - . maybe id setMaxSuccess (configQuickCheckMaxSuccess c)) QC.stdArgs - - setMaxSuccess :: Int -> QC.Args -> QC.Args - setMaxSuccess n args = args {QC.maxSuccess = n} - - setMaxSize :: Int -> QC.Args -> QC.Args - setMaxSize n args = args {QC.maxSize = n} - - setMaxDiscardRatio :: Int -> QC.Args -> QC.Args - setMaxDiscardRatio n args = args {QC.maxDiscardRatio = n} - - setSeed :: Integer -> QC.Args -> QC.Args - setSeed n args = args {QC.replay = Just (mkGen (fromIntegral n), 0)} - -getConfig :: Options -> String -> [String] -> IO Config -getConfig opts_ prog args = do - case parseOptions opts_ prog args of - Left (err, msg) -> exitWithMessage err msg - Right opts -> do - r <- if optionsRerun opts then readFailureReport else return Nothing - return (mkConfig r opts) - -exitWithMessage :: ExitCode -> String -> IO a -exitWithMessage err msg = do - hPutStr h msg - exitWith err - where - h = case err of - ExitSuccess -> stdout - _ -> stderr diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Core/QuickCheckUtil.hs haskell-hspec-2.1.5/src/Test/Hspec/Core/QuickCheckUtil.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Core/QuickCheckUtil.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Core/QuickCheckUtil.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,56 +0,0 @@ -{-# LANGUAGE CPP #-} -module Test.Hspec.Core.QuickCheckUtil where - -import Control.Applicative -import Data.Int -import Data.IORef -import Test.QuickCheck hiding (Result(..)) -import Test.QuickCheck as QC -import Test.QuickCheck.Property hiding (Result(..)) -import qualified Test.QuickCheck.Property as QCP -import Test.QuickCheck.IO () - - -#if MIN_VERSION_QuickCheck(2,7,0) -import Test.QuickCheck.Random -#endif - -import System.Random - -import Test.Hspec.Util - -aroundProperty :: (IO () -> IO ()) -> Property -> Property -#if MIN_VERSION_QuickCheck(2,7,0) -aroundProperty action (MkProperty p) = MkProperty $ MkProp . aroundRose action . unProp <$> p -#else -aroundProperty action p = MkProp . aroundRose action . unProp <$> p -#endif - -aroundRose :: (IO () -> IO ()) -> Rose QCP.Result -> Rose QCP.Result -aroundRose action r = ioRose $ do - ref <- newIORef (return QCP.succeeded) - action (reduceRose r >>= writeIORef ref) - readIORef ref - -formatNumbers :: Result -> String -formatNumbers r = "(after " ++ pluralize (numTests r) "test" ++ shrinks ++ ")" - where - shrinks - | 0 < numShrinks r = " and " ++ pluralize (numShrinks r) "shrink" - | otherwise = "" - -newSeed :: IO Int -newSeed = fst . randomR (0, fromIntegral (maxBound :: Int32)) <$> -#if MIN_VERSION_QuickCheck(2,7,0) - newQCGen -#else - newStdGen -#endif - -#if MIN_VERSION_QuickCheck(2,7,0) -mkGen :: Int -> QCGen -mkGen = mkQCGen -#else -mkGen :: Int -> StdGen -mkGen = mkStdGen -#endif diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Core/Type.hs haskell-hspec-2.1.5/src/Test/Hspec/Core/Type.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Core/Type.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Core/Type.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,205 +0,0 @@ -{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances, GeneralizedNewtypeDeriving, DeriveDataTypeable #-} -module Test.Hspec.Core.Type ( - Spec -, SpecM (..) -, runSpecM -, fromSpecList -, SpecTree (..) -, Item (..) -, mapSpecItem -, Example (..) -, Result (..) -, Params (..) -, Progress -, ProgressCallback - -, describe -, it -, forceResult - -, runIO - -, pending -, pendingWith -) where - -import qualified Control.Exception as E -import Control.Applicative -import Control.Monad.Trans.Writer -import Control.Monad.IO.Class (liftIO) -import Data.Typeable (Typeable) -import Data.List (isPrefixOf) -import Data.Maybe (fromMaybe) - -import Test.Hspec.Compat -import Test.Hspec.Util -import Test.Hspec.Expectations -import Test.HUnit.Lang (HUnitFailure(..)) -import qualified Test.QuickCheck as QC -import qualified Test.QuickCheck.State as QC -import qualified Test.QuickCheck.Property as QCP -import qualified Test.QuickCheck.IO () - -import Test.Hspec.Core.QuickCheckUtil -import Control.DeepSeq (deepseq) - -type Spec = SpecM () - --- | A writer monad for `SpecTree` forests. -newtype SpecM a = SpecM (WriterT [SpecTree] IO a) - deriving (Functor, Applicative, Monad) - --- | Convert a `Spec` to a forest of `SpecTree`s. -runSpecM :: Spec -> IO [SpecTree] -runSpecM (SpecM specs) = execWriterT specs - --- | Create a `Spec` from a forest of `SpecTree`s. -fromSpecList :: [SpecTree] -> Spec -fromSpecList = SpecM . tell - --- | Run an IO action while constructing the spec tree. --- --- `SpecM` is a monad to construct a spec tree, without executing any spec --- items. `runIO` allows you to run IO actions during this construction phase. --- The IO action is always run when the spec tree is constructed (e.g. even --- when @--dry-run@ is specified). -runIO :: IO a -> SpecM a -runIO = SpecM . liftIO - --- | The result of running an example. -data Result = Success | Pending (Maybe String) | Fail String - deriving (Eq, Show, Read, Typeable) - -forceResult :: Result -> Result -forceResult r = case r of - Success -> r - Pending m -> m `deepseq` r - Fail m -> m `deepseq` r - -instance E.Exception Result - -type Progress = (Int, Int) -type ProgressCallback = Progress -> IO () - -data Params = Params { - paramsQuickCheckArgs :: QC.Args -, paramsSmallCheckDepth :: Int -} deriving (Show) - --- | Internal representation of a spec. -data SpecTree = - SpecGroup String [SpecTree] - | BuildSpecs (IO [SpecTree]) - | SpecItem String Item - -data Item = Item { - itemIsParallelizable :: Bool -, itemExample :: Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result -} - -mapSpecItem :: (Item -> Item) -> Spec -> Spec -mapSpecItem f = fromSpecList . return . BuildSpecs . fmap (map go) . runSpecM - where - go :: SpecTree -> SpecTree - go spec = case spec of - SpecItem r item -> SpecItem r (f item) - BuildSpecs es -> BuildSpecs (map go <$> es) - SpecGroup d es -> SpecGroup d (map go es) - --- | The @describe@ function combines a list of specs into a larger spec. -describe :: String -> [SpecTree] -> SpecTree -describe s = SpecGroup msg - where - msg - | null s = "(no description given)" - | otherwise = s - --- | Create a spec item. -it :: Example a => String -> a -> SpecTree -it s e = SpecItem msg $ Item False (evaluateExample e) - where - msg - | null s = "(unspecified behavior)" - | otherwise = s - --- | A type class for examples. -class Example a where - evaluateExample :: a -> Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result - -instance Example Bool where - evaluateExample b _ _ _ = if b then return Success else return (Fail "") - -instance Example Expectation where - evaluateExample e _ action _ = (action e >> return Success) `E.catches` [ - E.Handler (\(HUnitFailure err) -> return (Fail err)) - , E.Handler (return :: Result -> IO Result) - ] - -instance Example Result where - evaluateExample r _ _ _ = return r - -instance Example QC.Property where - evaluateExample p c action progressCallback = do - r <- QC.quickCheckWithResult (paramsQuickCheckArgs c) {QC.chatty = False} (QCP.callback qcProgressCallback $ aroundProperty action p) - return $ - case r of - QC.Success {} -> Success - QC.Failure {QC.output = m} -> fromMaybe (Fail $ sanitizeFailureMessage r) (parsePending m) - QC.GaveUp {QC.numTests = n} -> Fail ("Gave up after " ++ pluralize n "test" ) - QC.NoExpectedFailure {} -> Fail ("No expected failure") - where - qcProgressCallback = QCP.PostTest QCP.NotCounterexample $ - \st _ -> progressCallback (QC.numSuccessTests st, QC.maxSuccessTests st) - - sanitizeFailureMessage :: QC.Result -> String - sanitizeFailureMessage r = let m = QC.output r in strip $ -#if MIN_VERSION_QuickCheck(2,7,0) - case QC.theException r of - Just e -> let numbers = formatNumbers r in - "uncaught exception: " ++ formatException e ++ " " ++ numbers ++ "\n" ++ case lines m of - x:xs | x == (exceptionPrefix ++ show e ++ "' " ++ numbers ++ ": ") -> unlines xs - _ -> m - Nothing -> -#endif - (addFalsifiable . stripFailed) m - - addFalsifiable :: String -> String - addFalsifiable m - | "(after " `isPrefixOf` m = "Falsifiable " ++ m - | otherwise = m - - stripFailed :: String -> String - stripFailed m - | prefix `isPrefixOf` m = drop n m - | otherwise = m - where - prefix = "*** Failed! " - n = length prefix - - parsePending :: String -> Maybe Result - parsePending m - | exceptionPrefix `isPrefixOf` m = (readMaybe . takeWhile (/= '\'') . drop n) m - | otherwise = Nothing - where - n = length exceptionPrefix - - exceptionPrefix = "*** Failed! Exception: '" - --- | Specifies a pending example. --- --- If you want to textually specify a behavior but do not have an example yet, --- use this: --- --- > describe "fancyFormatter" $ do --- > it "can format text in a way that everyone likes" $ --- > pending -pending :: Expectation -pending = E.throwIO (Pending Nothing) - --- | Specifies a pending example with a reason for why it's pending. --- --- > describe "fancyFormatter" $ do --- > it "can format text in a way that everyone likes" $ --- > pendingWith "waiting for clarification from the designers" -pendingWith :: String -> Expectation -pendingWith = E.throwIO . Pending . Just diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Core.hs haskell-hspec-2.1.5/src/Test/Hspec/Core.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Core.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Core.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,32 +1,18 @@ --- | --- Stability: experimental --- --- This module provides access to Hspec's internals. It is less stable than --- other parts of the API. For most users "Test.Hspec" is more suitable! -module Test.Hspec.Core ( - --- * A type class for examples - Example (..) -, Params (..) -, Progress -, ProgressCallback -, Result (..) - --- * A writer monad for constructing specs -, SpecM -, runSpecM -, fromSpecList - --- * Internal representation of a spec tree -, SpecTree (..) -, Item (..) -, mapSpecItem -, modifyParams +-- | Stability: unstable +module Test.Hspec.Core {-# DEPRECATED "use \"Test.Hspec.Core.Spec\" instead" #-} ( + module Test.Hspec.Core.Spec +-- * Deprecated functions , describe , it ) where -import Test.Hspec.Core.Type +import Test.Hspec.Core.Spec hiding (describe, it) + + +{-# DEPRECATED describe "use `specGroup` instead" #-} +describe :: String -> [SpecTree a] -> SpecTree a +describe = specGroup -modifyParams :: (Params -> Params) -> Spec -> Spec -modifyParams f = mapSpecItem $ \item -> item {itemExample = \p -> (itemExample item) (f p)} +{-# DEPRECATED it "use `specItem` instead" #-} +it :: Example a => String -> a -> SpecTree (Arg a) +it = specItem diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Discover.hs haskell-hspec-2.1.5/src/Test/Hspec/Discover.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Discover.hs 1970-01-01 00:00:00.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Discover.hs 2015-03-21 14:58:23.000000000 +0000 @@ -0,0 +1,98 @@ +{-# LANGUAGE FlexibleInstances #-} +module Test.Hspec.Discover {-# WARNING + "This module is used by @hspec-discover@. It is not part of the public API and may change at any time." + #-} ( + Spec +, hspec +, IsFormatter (..) +, hspecWithFormatter +, postProcessSpec +, describe +, module Prelude +) where + +import Control.Applicative +import Data.Maybe +import Data.List +import Data.Traversable hiding (mapM) +import Control.Monad.Trans.State + +import Test.Hspec.Core.Spec +import Test.Hspec.Core.Runner +import Test.Hspec.Formatters +import Test.Hspec.Core.Util (safeTry) + +class IsFormatter a where + toFormatter :: a -> IO Formatter + +instance IsFormatter (IO Formatter) where + toFormatter = id + +instance IsFormatter Formatter where + toFormatter = return + +hspecWithFormatter :: IsFormatter a => a -> Spec -> IO () +hspecWithFormatter formatter spec = do + f <- toFormatter formatter + hspecWith defaultConfig {configFormatter = Just f} spec + +postProcessSpec :: FilePath -> Spec -> Spec +postProcessSpec = locationHeuristicFromFile + +locationHeuristicFromFile :: FilePath -> Spec -> Spec +locationHeuristicFromFile file spec = do + mInput <- either (const Nothing) Just <$> (runIO . safeTry . readFile) file + let lookupLoc = maybe (\_ _ _ -> Nothing) (lookupLocation file) mInput + runIO (runSpecM spec) >>= fromSpecList . addLoctions lookupLoc + +addLoctions :: (Int -> Int -> String -> Maybe Location) -> [SpecTree a] -> [SpecTree a] +addLoctions lookupLoc = map (fmap f) . enumerate + where + f :: ((Int, Int), Item a) -> Item a + f ((n, total), item) = item {itemLocation = itemLocation item <|> lookupLoc n total (itemRequirement item)} + +type EnumerateM = State [(String, Int)] + +enumerate :: [SpecTree a] -> [Tree (ActionWith a) ((Int, Int), (Item a))] +enumerate tree = (mapM (traverse addPosition) tree >>= mapM (traverse addTotal)) `evalState` [] + where + addPosition :: Item a -> EnumerateM (Int, Item a) + addPosition item = (,) <$> getOccurrence (itemRequirement item) <*> pure item + + addTotal :: (Int, Item a) -> EnumerateM ((Int, Int), Item a) + addTotal (n, item) = do + total <- getTotal (itemRequirement item) + return ((n, total), item) + + getTotal :: String -> EnumerateM Int + getTotal requirement = do + gets $ fromMaybe err . lookup requirement + where + err = error ("Test.Hspec.Discover.getTotal: No entry for requirement " ++ show requirement ++ "!") + + getOccurrence :: String -> EnumerateM Int + getOccurrence requirement = do + xs <- get + let n = maybe 1 succ (lookup requirement xs) + put ((requirement, n) : filter ((/= requirement) . fst) xs) + return n + +lookupLocation :: FilePath -> String -> Int -> Int -> String -> Maybe Location +lookupLocation file input n total requirement = loc + where + loc :: Maybe Location + loc = Location file <$> line <*> pure 0 <*> pure BestEffort + + line :: Maybe Int + line = case occurrences of + xs | length xs == total -> Just (xs !! pred n) + _ -> Nothing + + occurrences :: [Int] + occurrences = map fst (filter p inputLines) + where + p :: (Int, String) -> Bool + p = isInfixOf (show requirement) . snd + + inputLines :: [(Int, String)] + inputLines = zip [1..] (lines input) diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/FailureReport.hs haskell-hspec-2.1.5/src/Test/Hspec/FailureReport.hs --- haskell-hspec-1.11.0/src/Test/Hspec/FailureReport.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/FailureReport.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,36 +0,0 @@ -module Test.Hspec.FailureReport ( - FailureReport (..) -, writeFailureReport -, readFailureReport -) where - -import System.IO -import System.SetEnv -import Test.Hspec.Compat -import Test.Hspec.Util (Path, safeTry) - -data FailureReport = FailureReport { - failureReportSeed :: Integer -, failureReportMaxSuccess :: Int -, failureReportMaxSize :: Int -, failureReportMaxDiscardRatio :: Int -, failureReportPaths :: [Path] -} deriving (Eq, Show, Read) - -writeFailureReport :: FailureReport -> IO () -writeFailureReport x = do - -- on Windows this can throw an exception when the input is too large, hence - -- we use `safeTry` here - safeTry (setEnv "HSPEC_FAILURES" $ show x) >>= either onError return - where - onError err = do - hPutStrLn stderr ("WARNING: Could not write environment variable HSPEC_FAILURES (" ++ show err ++ ")") - -readFailureReport :: IO (Maybe FailureReport) -readFailureReport = do - mx <- lookupEnv "HSPEC_FAILURES" - case mx >>= readMaybe of - Nothing -> do - hPutStrLn stderr "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!" - return Nothing - x -> return x diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Formatters/Internal.hs haskell-hspec-2.1.5/src/Test/Hspec/Formatters/Internal.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Formatters/Internal.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Formatters/Internal.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,263 +0,0 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Test.Hspec.Formatters.Internal ( - --- * Public API - Formatter (..) -, FormatM - -, getSuccessCount -, getPendingCount -, getFailCount -, getTotalCount - -, FailureRecord (..) -, getFailMessages -, usedSeed - -, getCPUTime -, getRealTime - -, write -, writeLine -, newParagraph - -, withSuccessColor -, withPendingColor -, withFailColor - --- * Functions for internal use -, runFormatM -, increaseSuccessCount -, increasePendingCount -, increaseFailCount -, addFailMessage -, finally_ -) where - -import qualified System.IO as IO -import System.IO (Handle) -import Control.Monad (when, unless) -import Control.Applicative -import Control.Exception (SomeException, AsyncException(..), bracket_, try, throwIO) -import System.Console.ANSI -import Control.Monad.Trans.State hiding (gets, modify) -import Control.Monad.IO.Class -import qualified System.CPUTime as CPUTime -import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) - -import Test.Hspec.Util (Path) -import Test.Hspec.Compat -import Test.Hspec.Core.Type (Progress) - --- | A lifted version of `Control.Monad.Trans.State.gets` -gets :: (FormatterState -> a) -> FormatM a -gets f = FormatM $ do - f <$> (get >>= liftIO . readIORef) - --- | A lifted version of `Control.Monad.Trans.State.modify` -modify :: (FormatterState -> FormatterState) -> FormatM () -modify f = FormatM $ do - get >>= liftIO . (`modifyIORef'` f) - -data FormatterState = FormatterState { - stateHandle :: Handle -, stateUseColor :: Bool -, produceHTML :: Bool -, lastIsEmptyLine :: Bool -- True, if last line was empty -, successCount :: Int -, pendingCount :: Int -, failCount :: Int -, failMessages :: [FailureRecord] -, stateUsedSeed :: Integer -, cpuStartTime :: Maybe Integer -, startTime :: POSIXTime -} - --- | The random seed that is used for QuickCheck. -usedSeed :: FormatM Integer -usedSeed = gets stateUsedSeed - --- | The total number of examples encountered so far. -totalCount :: FormatterState -> Int -totalCount s = successCount s + pendingCount s + failCount s - --- NOTE: We use an IORef here, so that the state persists when UserInterrupt is --- thrown. -newtype FormatM a = FormatM (StateT (IORef FormatterState) IO a) - deriving (Functor, Applicative, Monad, MonadIO) - -runFormatM :: Bool -> Bool -> Bool -> Integer -> Handle -> FormatM a -> IO a -runFormatM useColor produceHTML_ printCpuTime seed handle (FormatM action) = do - time <- getPOSIXTime - cpuTime <- if printCpuTime then Just <$> CPUTime.getCPUTime else pure Nothing - st <- newIORef (FormatterState handle useColor produceHTML_ False 0 0 0 [] seed cpuTime time) - evalStateT action st - --- | Increase the counter for successful examples -increaseSuccessCount :: FormatM () -increaseSuccessCount = modify $ \s -> s {successCount = succ $ successCount s} - --- | Increase the counter for pending examples -increasePendingCount :: FormatM () -increasePendingCount = modify $ \s -> s {pendingCount = succ $ pendingCount s} - --- | Increase the counter for failed examples -increaseFailCount :: FormatM () -increaseFailCount = modify $ \s -> s {failCount = succ $ failCount s} - --- | Get the number of successful examples encountered so far. -getSuccessCount :: FormatM Int -getSuccessCount = gets successCount - --- | Get the number of pending examples encountered so far. -getPendingCount :: FormatM Int -getPendingCount = gets pendingCount - --- | Get the number of failed examples encountered so far. -getFailCount :: FormatM Int -getFailCount = gets failCount - --- | Get the total number of examples encountered so far. -getTotalCount :: FormatM Int -getTotalCount = gets totalCount - --- | Append to the list of accumulated failure messages. -addFailMessage :: Path -> Either SomeException String -> FormatM () -addFailMessage p m = modify $ \s -> s {failMessages = FailureRecord p m : failMessages s} - --- | Get the list of accumulated failure messages. -getFailMessages :: FormatM [FailureRecord] -getFailMessages = reverse `fmap` gets failMessages - -data FailureRecord = FailureRecord { - failureRecordPath :: Path -, failureRecordMessage :: Either SomeException String -} - -data Formatter = Formatter { - - headerFormatter :: FormatM () - --- | evaluated before each test group --- --- The given number indicates the position within the parent group. -, exampleGroupStarted :: Int -> [String] -> String -> FormatM () - -, exampleGroupDone :: FormatM () - --- | used to notify the progress of the currently evaluated example --- --- /Note/: This is only called when interactive/color mode. -, exampleProgress :: Handle -> Path -> Progress -> IO () - --- | evaluated after each successful example -, exampleSucceeded :: Path -> FormatM () - --- | evaluated after each failed example -, exampleFailed :: Path -> Either SomeException String -> FormatM () - --- | evaluated after each pending example -, examplePending :: Path -> Maybe String -> FormatM () - --- | evaluated after a test run -, failedFormatter :: FormatM () - --- | evaluated after `failuresFormatter` -, footerFormatter :: FormatM () -} - - --- | Append an empty line to the report. --- --- Calling this multiple times has the same effect as calling it once. -newParagraph :: FormatM () -newParagraph = do - f <- gets lastIsEmptyLine - unless f $ do - writeLine "" - setLastIsEmptyLine True - -setLastIsEmptyLine :: Bool -> FormatM () -setLastIsEmptyLine f = modify $ \s -> s {lastIsEmptyLine = f} - --- | Append some output to the report. -write :: String -> FormatM () -write s = do - h <- gets stateHandle - liftIO $ IO.hPutStr h s - setLastIsEmptyLine False - --- | The same as `write`, but adds a newline character. -writeLine :: String -> FormatM () -writeLine s = write s >> write "\n" - --- | Set output color to red, run given action, and finally restore the default --- color. -withFailColor :: FormatM a -> FormatM a -withFailColor = withColor (SetColor Foreground Dull Red) "hspec-failure" - --- | Set output to color green, run given action, and finally restore the --- default color. -withSuccessColor :: FormatM a -> FormatM a -withSuccessColor = withColor (SetColor Foreground Dull Green) "hspec-success" - --- | Set output color to yellow, run given action, and finally restore the --- default color. -withPendingColor :: FormatM a -> FormatM a -withPendingColor = withColor (SetColor Foreground Dull Yellow) "hspec-pending" - --- | Set a color, run an action, and finally reset colors. -withColor :: SGR -> String -> FormatM a -> FormatM a -withColor color cls action = do - r <- gets produceHTML - (if r then htmlSpan cls else withColor_ color) action - -htmlSpan :: String -> FormatM a -> FormatM a -htmlSpan cls action = write ("") *> action <* write "" - -withColor_ :: SGR -> FormatM a -> FormatM a -withColor_ color (FormatM action) = do - useColor <- gets stateUseColor - h <- gets stateHandle - - FormatM . StateT $ \st -> do - bracket_ - - -- set color - (when useColor $ hSetSGR h [color]) - - -- reset colors - (when useColor $ hSetSGR h [Reset]) - - -- run action - (runStateT action st) - --- | --- @finally_ actionA actionB@ runs @actionA@ and then @actionB@. @actionB@ is --- run even when a `UserInterrupt` occurs during @actionA@. -finally_ :: FormatM () -> FormatM () -> FormatM () -finally_ (FormatM actionA) (FormatM actionB) = FormatM . StateT $ \st -> do - r <- try (execStateT actionA st) - case r of - Left e -> do - when (e == UserInterrupt) $ - runStateT actionB st >> return () - throwIO e - Right st_ -> do - runStateT actionB st_ - --- | Get the used CPU time since the test run has been started. -getCPUTime :: FormatM (Maybe Double) -getCPUTime = do - t1 <- liftIO CPUTime.getCPUTime - mt0 <- gets cpuStartTime - return $ toSeconds <$> ((-) <$> pure t1 <*> mt0) - where - toSeconds x = fromIntegral x / (10.0 ^ (12 :: Integer)) - --- | Get the passed real time since the test run has been started. -getRealTime :: FormatM Double -getRealTime = do - t1 <- liftIO getPOSIXTime - t0 <- gets startTime - return (realToFrac $ t1 - t0) diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Formatters.hs haskell-hspec-2.1.5/src/Test/Hspec/Formatters.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Formatters.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Formatters.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,221 +1,2 @@ -{-# LANGUAGE FlexibleInstances #-} --- | --- Stability: experimental --- --- This module contains formatters that can be used with --- `Test.Hspec.Runner.hspecWith`. -module Test.Hspec.Formatters ( - --- * Formatters - silent -, specdoc -, progress -, failed_examples - --- * Implementing a custom Formatter --- | --- A formatter is a set of actions. Each action is evaluated when a certain --- situation is encountered during a test run. --- --- Actions live in the `FormatM` monad. It provides access to the runner state --- and primitives for appending to the generated report. -, Formatter (..) -, FormatM - --- ** Accessing the runner state -, getSuccessCount -, getPendingCount -, getFailCount -, getTotalCount - -, FailureRecord (..) -, getFailMessages -, usedSeed - -, getCPUTime -, getRealTime - --- ** Appending to the gerenated report -, write -, writeLine -, newParagraph - --- ** Dealing with colors -, withSuccessColor -, withPendingColor -, withFailColor - --- ** Helpers -, formatException - --- * Using custom formatters with @hspec-discover@ --- | --- Anything that is an instance of `IsFormatter` can be used by --- @hspec-discover@ as the default formatter for a spec. If you have a --- formatter @myFormatter@ in the module @Custom.Formatters@ you can use it --- by passing an additional argument to @hspec-discover@. --- --- >{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --formatter=Custom.Formatters.myFormatter #-} -, IsFormatter (..) -) where - -import Data.Maybe -import Test.Hspec.Util -import Text.Printf -import Control.Monad (unless, forM_) -import Control.Applicative -import System.IO (hPutStr, hFlush) - --- We use an explicit import list for "Test.Hspec.Formatters.Internal", to make --- sure, that we only use the public API to implement formatters. --- --- Everything imported here has to be re-exported, so that users can implement --- their own formatters. -import Test.Hspec.Formatters.Internal ( - Formatter (..) - , FormatM - - , getSuccessCount - , getPendingCount - , getFailCount - , getTotalCount - - , FailureRecord (..) - , getFailMessages - , usedSeed - - , getCPUTime - , getRealTime - - , write - , writeLine - , newParagraph - - , withSuccessColor - , withPendingColor - , withFailColor - ) - -class IsFormatter a where - toFormatter :: a -> IO Formatter - -instance IsFormatter (IO Formatter) where - toFormatter = id - -instance IsFormatter Formatter where - toFormatter = return - -silent :: Formatter -silent = Formatter { - headerFormatter = return () -, exampleGroupStarted = \_ _ _ -> return () -, exampleGroupDone = return () -, exampleProgress = \_ _ _ -> return () -, exampleSucceeded = \_ -> return () -, exampleFailed = \_ _ -> return () -, examplePending = \_ _ -> return () -, failedFormatter = return () -, footerFormatter = return () -} - - -specdoc :: Formatter -specdoc = silent { - - headerFormatter = do - writeLine "" - -, exampleGroupStarted = \n nesting name -> do - - -- separate groups with an empty line - unless (n == 0) $ do - newParagraph - - writeLine (indentationFor nesting ++ name) - -, exampleGroupDone = do - newParagraph - -, exampleProgress = \h _ p -> do - hPutStr h (formatProgress p) - hFlush h - -, exampleSucceeded = \(nesting, requirement) -> withSuccessColor $ do - writeLine $ indentationFor nesting ++ "- " ++ requirement - -, exampleFailed = \(nesting, requirement) _ -> withFailColor $ do - n <- getFailCount - writeLine $ indentationFor nesting ++ "- " ++ requirement ++ " FAILED [" ++ show n ++ "]" - -, examplePending = \(nesting, requirement) reason -> withPendingColor $ do - writeLine $ indentationFor nesting ++ "- " ++ requirement ++ "\n # PENDING: " ++ fromMaybe "No reason given" reason - -, failedFormatter = defaultFailedFormatter - -, footerFormatter = defaultFooter -} where - indentationFor nesting = replicate (length nesting * 2) ' ' - formatProgress (current, total) - | total == 0 = show current ++ "\r" - | otherwise = show current ++ "/" ++ show total ++ "\r" - - -progress :: Formatter -progress = silent { - exampleSucceeded = \_ -> withSuccessColor $ write "." -, exampleFailed = \_ _ -> withFailColor $ write "F" -, examplePending = \_ _ -> withPendingColor $ write "." -, failedFormatter = defaultFailedFormatter -, footerFormatter = defaultFooter -} - - -failed_examples :: Formatter -failed_examples = silent { - failedFormatter = defaultFailedFormatter -, footerFormatter = defaultFooter -} - -defaultFailedFormatter :: FormatM () -defaultFailedFormatter = do - newParagraph - - failures <- getFailMessages - - forM_ (zip [1..] failures) $ \x -> do - formatFailure x - writeLine "" - unless (null failures) $ do - write "Randomized with seed " >> usedSeed >>= writeLine . show - writeLine "" - where - formatFailure :: (Int, FailureRecord) -> FormatM () - formatFailure (n, FailureRecord path reason) = do - write (show n ++ ") ") - writeLine (formatRequirement path) - withFailColor $ do - unless (null err) $ do - writeLine err - where - err = either (("uncaught exception: " ++) . formatException) id reason - -defaultFooter :: FormatM () -defaultFooter = do - - writeLine =<< (++) - <$> (printf "Finished in %1.4f seconds" - <$> getRealTime) <*> (maybe "" (printf ", used %1.4f seconds of CPU time") <$> getCPUTime) - - fails <- getFailCount - pending <- getPendingCount - total <- getTotalCount - - let c | fails /= 0 = withFailColor - | pending /= 0 = withPendingColor - | otherwise = withSuccessColor - c $ do - write $ pluralize total "example" - write (", " ++ pluralize fails "failure") - unless (pending == 0) $ - write (", " ++ show pending ++ " pending") - writeLine "" +module Test.Hspec.Formatters (module Test.Hspec.Core.Formatters) where +import Test.Hspec.Core.Formatters diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/HUnit.hs haskell-hspec-2.1.5/src/Test/Hspec/HUnit.hs --- haskell-hspec-1.11.0/src/Test/Hspec/HUnit.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/HUnit.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,23 +1,24 @@ -module Test.Hspec.HUnit ( +module Test.Hspec.HUnit {-# DEPRECATED "use \"Test.Hspec.Contrib.HUnit\" from package @hspec-contrib@ instead" #-} +( -- * Interoperability with HUnit fromHUnitTest ) where -import Test.Hspec.Core.Type +import Test.Hspec.Core.Spec import Test.HUnit (Test (..)) -- | -- Convert a HUnit test suite to a spec. This can be used to run existing -- HUnit tests with Hspec. fromHUnitTest :: Test -> Spec -fromHUnitTest t = fromSpecList $ case t of - TestList xs -> map go xs - x -> [go x] +fromHUnitTest t = case t of + TestList xs -> mapM_ go xs + x -> go x where - go :: Test -> SpecTree + go :: Test -> Spec go t_ = case t_ of - TestLabel s (TestCase e) -> it s e - TestLabel s (TestList xs) -> describe s (map go xs) - TestLabel s x -> describe s [go x] - TestList xs -> describe "" (map go xs) - TestCase e -> it "" e + TestLabel s (TestCase e) -> it s e + TestLabel s (TestList xs) -> describe s (mapM_ go xs) + TestLabel s x -> describe s (go x) + TestList xs -> describe "" (mapM_ go xs) + TestCase e -> it "" e diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Options.hs haskell-hspec-2.1.5/src/Test/Hspec/Options.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Options.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Options.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,154 +0,0 @@ -module Test.Hspec.Options ( - Options (..) -, ColorMode (..) -, defaultOptions -, parseOptions - --- exported to silence warnings -, Arg (..) -) where - -import Data.List -import System.Exit -import System.Console.GetOpt - -import Test.Hspec.Formatters -import Test.Hspec.Compat -import Test.Hspec.Util - -data Options = Options { - optionsDryRun :: Bool -, optionsPrintCpuTime :: Bool -, optionsRerun :: Bool -, optionsFastFail :: Bool -, optionsMatch :: [String] -, optionsMaxSuccess :: Maybe Int -, optionsDepth :: Maybe Int -, optionsSeed :: Maybe Integer -, optionsMaxSize :: Maybe Int -, optionsMaxDiscardRatio :: Maybe Int -, optionsColorMode :: ColorMode -, optionsFormatter :: Formatter -, optionsHtmlOutput :: Bool -, optionsOutputFile :: Maybe FilePath -} - -addMatch :: String -> Options -> Options -addMatch s c = c {optionsMatch = s : optionsMatch c} - -setDepth :: Int -> Options -> Options -setDepth n c = c {optionsDepth = Just n} - -setMaxSuccess :: Int -> Options -> Options -setMaxSuccess n c = c {optionsMaxSuccess = Just n} - -setMaxSize :: Int -> Options -> Options -setMaxSize n c = c {optionsMaxSize = Just n} - -setMaxDiscardRatio :: Int -> Options -> Options -setMaxDiscardRatio n c = c {optionsMaxDiscardRatio = Just n} - -setSeed :: Integer -> Options -> Options -setSeed n c = c {optionsSeed = Just n} - -data ColorMode = ColorAuto | ColorNever | ColorAlways - deriving (Eq, Show) - -defaultOptions :: Options -defaultOptions = Options False False False False [] Nothing Nothing Nothing Nothing Nothing ColorAuto specdoc False Nothing - -formatters :: [(String, Formatter)] -formatters = [ - ("specdoc", specdoc) - , ("progress", progress) - , ("failed-examples", failed_examples) - , ("silent", silent) - ] - -formatHelp :: String -formatHelp = unlines (addLineBreaks "use a custom formatter; this can be one of:" ++ map ((" " ++) . fst) formatters) - -type Result = Either NoConfig Options - -data NoConfig = Help | InvalidArgument String String - -data Arg a = Arg { - argumentName :: String -, argumentParser :: String -> Maybe a -, argumentSetter :: a -> Options -> Options -} - -mkOption :: [Char] -> String -> Arg a -> String -> OptDescr (Result -> Result) -mkOption shortcut name (Arg argName parser setter) help = Option shortcut [name] (ReqArg arg argName) help - where - arg :: String -> Result -> Result - arg input x = x >>= \c -> case parser input of - Just n -> Right (setter n c) - Nothing -> Left (InvalidArgument name input) - -addLineBreaks :: String -> [String] -addLineBreaks = lineBreaksAt 44 - -options :: [OptDescr (Result -> Result)] -options = [ - Option [] ["help"] (NoArg (const $ Left Help)) (h "display this help and exit") - , mkOption "m" "match" (Arg "PATTERN" return addMatch) (h "only run examples that match given PATTERN") - , Option [] ["color"] (NoArg setColor) (h "colorize the output") - , Option [] ["no-color"] (NoArg setNoColor) (h "do not colorize the output") - , mkOption "f" "format" (Arg "FORMATTER" readFormatter setFormatter) formatHelp - , mkOption "o" "out" (Arg "FILE" return setOutputFile) (h "write output to a file instead of STDOUT") - , mkOption [] "depth" (Arg "N" readMaybe setDepth) (h "maximum depth of generated test values for SmallCheck properties") - , mkOption "a" "qc-max-success" (Arg "N" readMaybe setMaxSuccess) (h "maximum number of successful tests before a QuickCheck property succeeds") - , mkOption "" "qc-max-size" (Arg "N" readMaybe setMaxSize) (h "size to use for the biggest test cases") - , mkOption "" "qc-max-discard" (Arg "N" readMaybe setMaxDiscardRatio) (h "maximum number of discarded tests per successful test before giving up") - , mkOption [] "seed" (Arg "N" readMaybe setSeed) (h "used seed for QuickCheck properties") - , Option [] ["print-cpu-time"] (NoArg setPrintCpuTime) (h "include used CPU time in summary") - , Option [] ["dry-run"] (NoArg setDryRun) (h "pretend that everything passed; don't verify anything") - , Option [] ["fail-fast"] (NoArg setFastFail) (h "abort on first failure") - , Option "r" ["rerun"] (NoArg setRerun) (h "rerun all examples that failed in the previously test run (only works in GHCi)") - ] - where - h = unlines . addLineBreaks - - readFormatter :: String -> Maybe Formatter - readFormatter = (`lookup` formatters) - - setFormatter :: Formatter -> Options -> Options - setFormatter f c = c {optionsFormatter = f} - - setOutputFile :: String -> Options -> Options - setOutputFile file c = c {optionsOutputFile = Just file} - - setPrintCpuTime x = x >>= \c -> return c {optionsPrintCpuTime = True} - setDryRun x = x >>= \c -> return c {optionsDryRun = True} - setFastFail x = x >>= \c -> return c {optionsFastFail = True} - setRerun x = x >>= \c -> return c {optionsRerun = True} - setNoColor x = x >>= \c -> return c {optionsColorMode = ColorNever} - setColor x = x >>= \c -> return c {optionsColorMode = ColorAlways} - -undocumentedOptions :: [OptDescr (Result -> Result)] -undocumentedOptions = [ - -- for compatibility with test-framework - mkOption [] "maximum-generated-tests" (Arg "NUMBER" readMaybe setMaxSuccess) "how many automated tests something like QuickCheck should try, by default" - - -- undocumented for now, as we probably want to change this to produce a - -- standalone HTML report in the future - , Option [] ["html"] (NoArg setHtml) "produce HTML output" - - -- now a noop - , Option "v" ["verbose"] (NoArg id) "do not suppress output to stdout when evaluating examples" - ] - where - setHtml :: Result -> Result - setHtml x = x >>= \c -> return c {optionsHtmlOutput = True} - -parseOptions :: Options -> String -> [String] -> Either (ExitCode, String) Options -parseOptions c prog args = case getOpt Permute (options ++ undocumentedOptions) args of - (opts, [], []) -> case foldl' (flip id) (Right c) opts of - Left Help -> Left (ExitSuccess, usageInfo ("Usage: " ++ prog ++ " [OPTION]...\n\nOPTIONS") options) - Left (InvalidArgument flag value) -> tryHelp ("invalid argument `" ++ value ++ "' for `--" ++ flag ++ "'\n") - Right x -> Right x - (_, _, err:_) -> tryHelp err - (_, arg:_, _) -> tryHelp ("unexpected argument `" ++ arg ++ "'\n") - where - tryHelp msg = Left (ExitFailure 1, prog ++ ": " ++ msg ++ "Try `" ++ prog ++ " --help' for more information.\n") diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/QuickCheck.hs haskell-hspec-2.1.5/src/Test/Hspec/QuickCheck.hs --- haskell-hspec-1.11.0/src/Test/Hspec/QuickCheck.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/QuickCheck.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,5 +1,3 @@ --- | --- Stability: provisional module Test.Hspec.QuickCheck ( -- * Params modifyMaxSuccess @@ -10,9 +8,9 @@ , prop ) where -import Test.QuickCheck import Test.Hspec -import Test.Hspec.Core (Params(..), modifyParams) +import Test.QuickCheck +import Test.Hspec.Core.QuickCheck -- | -- > prop ".." $ @@ -24,30 +22,3 @@ -- > .. prop :: Testable prop => String -> prop -> Spec prop s = it s . property - --- | Use a modified `maxSuccess` for given spec. -modifyMaxSuccess :: (Int -> Int) -> Spec -> Spec -modifyMaxSuccess = modifyArgs . modify - where - modify :: (Int -> Int) -> Args -> Args - modify f args = args {maxSuccess = f (maxSuccess args)} - --- | Use a modified `maxDiscardRatio` for given spec. -modifyMaxDiscardRatio :: (Int -> Int) -> Spec -> Spec -modifyMaxDiscardRatio = modifyArgs . modify - where - modify :: (Int -> Int) -> Args -> Args - modify f args = args {maxDiscardRatio = f (maxDiscardRatio args)} - --- | Use a modified `maxSize` for given spec. -modifyMaxSize :: (Int -> Int) -> Spec -> Spec -modifyMaxSize = modifyArgs . modify - where - modify :: (Int -> Int) -> Args -> Args - modify f args = args {maxSize = f (maxSize args)} - -modifyArgs :: (Args -> Args) -> Spec -> Spec -modifyArgs = modifyParams . modify - where - modify :: (Args -> Args) -> Params -> Params - modify f p = p {paramsQuickCheckArgs = f (paramsQuickCheckArgs p)} diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Runner/Eval.hs haskell-hspec-2.1.5/src/Test/Hspec/Runner/Eval.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Runner/Eval.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Runner/Eval.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,145 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -module Test.Hspec.Runner.Eval (runFormatter) where - -import Control.Applicative -import Control.Monad -import qualified Control.Exception as E -import Control.Concurrent -import System.IO (Handle) - -import Control.Monad.IO.Class (liftIO) - -import Test.Hspec.Util -import Test.Hspec.Runner.Tree -import Test.Hspec.Core.Type -import Test.Hspec.Config -import Test.Hspec.Formatters -import Test.Hspec.Formatters.Internal -import Test.Hspec.Timer -import Data.Time.Clock.POSIX - -type EvalTree = Tree (ProgressCallback -> FormatResult -> IO (FormatM ())) - --- | Evaluate all examples of a given spec and produce a report. -runFormatter :: Bool -> Handle -> Config -> Formatter -> [Tree Item] -> FormatM () -runFormatter useColor h c formatter specs_ = do - headerFormatter formatter - chan <- liftIO newChan - reportProgress <- liftIO mkReportProgress - run chan reportProgress c formatter specs - where - mkReportProgress :: IO (Path -> Progress -> IO ()) - mkReportProgress - | useColor = every 0.05 $ exampleProgress formatter h - | otherwise = return $ \_ _ -> return () - - specs = map (fmap (parallelize . fmap (applyNoOpAround . applyParams) . unwrapItem)) specs_ - - unwrapItem :: Item -> (Bool, Params -> (IO () -> IO ()) -> ProgressCallback -> IO Result) - unwrapItem (Item isParallelizable e) = (isParallelizable, e) - - applyParams :: (Params -> a) -> a - applyParams = ($ params) - where - params = Params (configQuickCheckArgs c) (configSmallCheckDepth c) - - applyNoOpAround :: ((IO () -> IO ()) -> b) -> b - applyNoOpAround = ($ id) - --- | Execute given action at most every specified number of seconds. -every :: POSIXTime -> (a -> b -> IO ()) -> IO (a -> b -> IO ()) -every seconds action = do - timer <- newTimer seconds - return $ \a b -> do - r <- timer - when r (action a b) - -type FormatResult = Either E.SomeException Result -> FormatM () - -parallelize :: (Bool, ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ()) -parallelize (isParallelizable, e) - | isParallelizable = runParallel e - | otherwise = runSequentially e - -runSequentially :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ()) -runSequentially e reportProgress formatResult = return $ do - result <- liftIO $ evalExample (e reportProgress) - formatResult result - -data Report = ReportProgress Progress | ReportResult (Either E.SomeException Result) - -runParallel :: (ProgressCallback -> IO Result) -> ProgressCallback -> FormatResult -> IO (FormatM ()) -runParallel e reportProgress formatResult = do - mvar <- newEmptyMVar - _ <- forkIO $ do - let progressCallback = replaceMVar mvar . ReportProgress - result <- evalExample (e progressCallback) - replaceMVar mvar (ReportResult result) - return $ evalReport mvar - where - evalReport :: MVar Report -> FormatM () - evalReport mvar = do - r <- liftIO (takeMVar mvar) - case r of - ReportProgress p -> do - liftIO $ reportProgress p - evalReport mvar - ReportResult result -> formatResult result - -replaceMVar :: MVar a -> a -> IO () -replaceMVar mvar p = tryTakeMVar mvar >> putMVar mvar p - -evalExample :: IO Result -> IO (Either E.SomeException Result) -evalExample e = safeTry $ forceResult <$> e - -data Message = Done | Run (FormatM ()) - -run :: Chan Message -> (Path -> ProgressCallback) -> Config -> Formatter -> [EvalTree] -> FormatM () -run chan reportProgress_ c formatter specs = do - liftIO $ do - forM_ (zip [0..] specs) (queueSpec []) - writeChan chan Done - processMessages (readChan chan) (configFastFail c) - where - defer :: FormatM () -> IO () - defer = writeChan chan . Run - - queueSpec :: [String] -> (Int, EvalTree) -> IO () - queueSpec rGroups (n, Node group xs) = do - defer (exampleGroupStarted formatter n (reverse rGroups) group) - forM_ (zip [0..] xs) (queueSpec (group : rGroups)) - defer (exampleGroupDone formatter) - queueSpec rGroups (_, Leaf requirement e) = - queueExample (reverse rGroups, requirement) e - - queueExample :: Path -> (ProgressCallback -> FormatResult -> IO (FormatM ())) -> IO () - queueExample path e = e reportProgress formatResult >>= defer - where - reportProgress = reportProgress_ path - - formatResult :: Either E.SomeException Result -> FormatM () - formatResult result = do - case result of - Right Success -> do - increaseSuccessCount - exampleSucceeded formatter path - Right (Pending reason) -> do - increasePendingCount - examplePending formatter path reason - Right (Fail err) -> failed (Right err) - Left err -> failed (Left err) - where - failed err = do - increaseFailCount - addFailMessage path err - exampleFailed formatter path err - -processMessages :: IO Message -> Bool -> FormatM () -processMessages getMessage fastFail = go - where - go = liftIO getMessage >>= \m -> case m of - Run action -> do - action - fails <- getFailCount - unless (fastFail && fails /= 0) go - Done -> return () diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Runner/Tree.hs haskell-hspec-2.1.5/src/Test/Hspec/Runner/Tree.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Runner/Tree.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Runner/Tree.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,18 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -module Test.Hspec.Runner.Tree where - -import Control.Applicative -import Test.Hspec.Core.Type - -data Tree a - = Node !String [Tree a] - | Leaf !String a - deriving (Eq, Show, Functor) - -toTree :: Spec -> IO [Tree Item] -toTree spec = concat <$> (runSpecM spec >>= mapM go) - where - go x = case x of - SpecGroup label xs -> return . Node label . concat <$> mapM go xs - BuildSpecs xs -> concat <$> (xs >>= mapM go) - SpecItem r item -> return [Leaf r item] diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Runner.hs haskell-hspec-2.1.5/src/Test/Hspec/Runner.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Runner.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Runner.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,168 +1,2 @@ --- | --- Stability: provisional -module Test.Hspec.Runner ( --- * Running a spec - hspec -, hspecResult -, hspecWith - --- * Types -, Summary (..) -, Config (..) -, ColorMode (..) -, Path -, defaultConfig -, configAddFilter - --- * Internals -, hspecWithFormatter -) where - -import Control.Monad -import Control.Applicative -import Data.Monoid -import Data.Maybe -import System.IO -import System.Environment (getProgName, getArgs, withArgs) -import System.Exit -import qualified Control.Exception as E - -import System.Console.ANSI (hHideCursor, hShowCursor) -import qualified Test.QuickCheck as QC -import Control.Monad.IO.Class (liftIO) - -import Test.Hspec.Compat (lookupEnv) -import Test.Hspec.Util (Path) -import Test.Hspec.Core.Type -import Test.Hspec.Config -import Test.Hspec.Formatters -import Test.Hspec.Formatters.Internal -import Test.Hspec.FailureReport -import Test.Hspec.Core.QuickCheckUtil - -import Test.Hspec.Options (Options(..), ColorMode(..), defaultOptions) -import Test.Hspec.Runner.Tree -import Test.Hspec.Runner.Eval - --- | Filter specs by given predicate. --- --- The predicate takes a list of "describe" labels and a "requirement". -filterSpecs :: (Path -> Bool) -> [Tree a] -> [Tree a] -filterSpecs p = goSpecs [] - where - goSpecs groups = mapMaybe (goSpec groups) - - goSpec groups spec = case spec of - Leaf requirement _ -> guard (p (groups, requirement)) >> return spec - Node group specs -> case goSpecs (groups ++ [group]) specs of - [] -> Nothing - xs -> Just (Node group xs) - --- | Run given spec and write a report to `stdout`. --- Exit with `exitFailure` if at least one spec item fails. -hspec :: Spec -> IO () -hspec = hspecWithOptions defaultOptions - --- | This function is used by @hspec-discover@. It is not part of the public --- API and may change at any time. -hspecWithFormatter :: IsFormatter a => a -> Spec -> IO () -hspecWithFormatter formatter spec = do - f <- toFormatter formatter - hspecWithOptions defaultOptions {optionsFormatter = f} spec - --- Add a seed to given config if there is none. That way the same seed is used --- for all properties. This helps with --seed and --rerun. -ensureSeed :: Config -> IO Config -ensureSeed c = case configQuickCheckSeed c of - Nothing -> do - seed <- newSeed - return c {configQuickCheckSeed = Just (fromIntegral seed)} - _ -> return c - --- | Run given spec with custom options. --- This is similar to `hspec`, but more flexible. -hspecWithOptions :: Options -> Spec -> IO () -hspecWithOptions opts spec = do - prog <- getProgName - args <- getArgs - c <- getConfig opts prog args - withArgs [] {- do not leak command-line arguments to examples -} $ do - r <- hspecWith c spec - unless (summaryFailures r == 0) exitFailure - --- | Run given spec and returns a summary of the test run. --- --- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec --- items. If you need this, you have to check the `Summary` yourself and act --- accordingly. -hspecResult :: Spec -> IO Summary -hspecResult = hspecWith defaultConfig - --- | Run given spec with custom options and returns a summary of the test run. --- --- /Note/: `hspecWith` does not exit with `exitFailure` on failing spec --- items. If you need this, you have to check the `Summary` yourself and act --- accordingly. -hspecWith :: Config -> Spec -> IO Summary -hspecWith c_ spec_ = withHandle c_ $ \h -> do - c <- ensureSeed c_ - let formatter = configFormatter c - seed = (fromJust . configQuickCheckSeed) c - qcArgs = configQuickCheckArgs c - spec - | configDryRun c = mapSpecItem markSuccess spec_ - | otherwise = spec_ - - useColor <- doesUseColor h c - filteredSpec <- maybe id filterSpecs (configFilterPredicate c) <$> toTree spec - - withHiddenCursor useColor h $ - runFormatM useColor (configHtmlOutput c) (configPrintCpuTime c) seed h $ do - runFormatter useColor h c formatter filteredSpec `finally_` do - failedFormatter formatter - - footerFormatter formatter - - -- dump failure report - xs <- map failureRecordPath <$> getFailMessages - liftIO $ writeFailureReport FailureReport { - failureReportSeed = seed - , failureReportMaxSuccess = QC.maxSuccess qcArgs - , failureReportMaxSize = QC.maxSize qcArgs - , failureReportMaxDiscardRatio = QC.maxDiscardRatio qcArgs - , failureReportPaths = xs - } - - Summary <$> getTotalCount <*> getFailCount - where - withHiddenCursor :: Bool -> Handle -> IO a -> IO a - withHiddenCursor useColor h - | useColor = E.bracket_ (hHideCursor h) (hShowCursor h) - | otherwise = id - - doesUseColor :: Handle -> Config -> IO Bool - doesUseColor h c = case configColorMode c of - ColorAuto -> (&&) <$> hIsTerminalDevice h <*> (not <$> isDumb) - ColorNever -> return False - ColorAlways -> return True - - withHandle :: Config -> (Handle -> IO a) -> IO a - withHandle c action = case configHandle c of - Left h -> action h - Right path -> withFile path WriteMode action - -isDumb :: IO Bool -isDumb = maybe False (== "dumb") <$> lookupEnv "TERM" - -markSuccess :: Item -> Item -markSuccess item = item {itemExample = evaluateExample Success} - --- | Summary of a test run. -data Summary = Summary { - summaryExamples :: Int -, summaryFailures :: Int -} deriving (Eq, Show) - -instance Monoid Summary where - mempty = Summary 0 0 - (Summary x1 x2) `mappend` (Summary y1 y2) = Summary (x1 + y1) (x2 + y2) +module Test.Hspec.Runner (module Test.Hspec.Core.Runner) where +import Test.Hspec.Core.Runner diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Timer.hs haskell-hspec-2.1.5/src/Test/Hspec/Timer.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Timer.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Timer.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,14 +0,0 @@ -module Test.Hspec.Timer where - -import Data.IORef -import Data.Time.Clock.POSIX - -newTimer :: POSIXTime -> IO (IO Bool) -newTimer delay = do - ref <- getPOSIXTime >>= newIORef - return $ do - t0 <- readIORef ref - t1 <- getPOSIXTime - if delay < t1 - t0 - then writeIORef ref t1 >> return True - else return False diff -Nru haskell-hspec-1.11.0/src/Test/Hspec/Util.hs haskell-hspec-2.1.5/src/Test/Hspec/Util.hs --- haskell-hspec-1.11.0/src/Test/Hspec/Util.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec/Util.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,95 +0,0 @@ -module Test.Hspec.Util ( - pluralize -, formatException -, lineBreaksAt -, safeTry -, Path -, filterPredicate -, formatRequirement -, strip -) where - -import Data.List -import Data.Char (isSpace) -import qualified Control.Exception as E -import Control.Concurrent.Async - -import Test.Hspec.Compat (showType) - - --- | Create a more readable display of a quantity of something. --- --- Examples: --- --- >>> pluralize 0 "example" --- "0 examples" --- --- >>> pluralize 1 "example" --- "1 example" --- --- >>> pluralize 2 "example" --- "2 examples" -pluralize :: Int -> String -> String -pluralize 1 s = "1 " ++ s -pluralize n s = show n ++ " " ++ s ++ "s" - --- | Convert an exception to a string. --- --- The type of the exception is included. Here is an example: --- --- >>> import Control.Applicative --- >>> import Control.Exception --- >>> either formatException show <$> (try . evaluate) (1 `div` 0) --- "ArithException (divide by zero)" -formatException :: E.SomeException -> String -formatException (E.SomeException e) = showType e ++ " (" ++ show e ++ ")" - -safeTry :: IO a -> IO (Either E.SomeException a) -safeTry action = withAsync (action >>= E.evaluate) waitCatch - --- | --- A tuple that represents the location of an example within a spec. --- --- It consists of a list of group descriptions and a requirement description. -type Path = ([String], String) - --- | A predicate that can be used to filter specs. -filterPredicate :: String -> Path -> Bool -filterPredicate pattern path@(groups, requirement) = - pattern `isInfixOf` plain - || pattern `isInfixOf` formatted - where - plain = intercalate "/" (groups ++ [requirement]) - formatted = formatRequirement path - --- | --- Try to create a proper English sentence from a path by applying some --- heuristics. -formatRequirement :: Path -> String -formatRequirement (groups, requirement) = groups_ ++ requirement - where - groups_ = case break (any isSpace) groups of - ([], ys) -> join ys - (xs, ys) -> join (intercalate "." xs : ys) - - join xs = case xs of - [x] -> x ++ " " - ys -> concatMap (++ ", ") ys - --- ensure that lines are not longer then given `n`, insert line breaks at word --- boundaries -lineBreaksAt :: Int -> String -> [String] -lineBreaksAt n input = case words input of - [] -> [] - x:xs -> go (x, xs) - where - go :: (String, [String]) -> [String] - go c = case c of - (s, []) -> [s] - (s, y:ys) -> let r = s ++ " " ++ y in - if length r <= n - then go (r, ys) - else s : go (y, ys) - -strip :: String -> String -strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse diff -Nru haskell-hspec-1.11.0/src/Test/Hspec.hs haskell-hspec-2.1.5/src/Test/Hspec.hs --- haskell-hspec-1.11.0/src/Test/Hspec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/src/Test/Hspec.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,7 +1,7 @@ -- | -- Stability: stable -- --- Hspec is a testing library for Haskell. +-- Hspec is a testing framework for Haskell. -- -- This is the library reference for Hspec. -- The contains more in-depth @@ -9,6 +9,8 @@ module Test.Hspec ( -- * Types Spec +, SpecWith +, Arg , Example -- * Setting expectations @@ -18,50 +20,37 @@ , describe , context , it +, specify , example , pending , pendingWith +, parallel +, runIO + +-- * Hooks +, ActionWith , before +, before_ +, beforeWith +, beforeAll , after +, after_ +, afterAll +, afterAll_ , around -, parallel -, runIO +, around_ +, aroundWith -- * Running a spec , hspec ) where -import Control.Exception (finally) - -import Test.Hspec.Core.Type hiding (describe, it) +import Test.Hspec.Core.Spec +import Test.Hspec.Core.Hooks import Test.Hspec.Runner -import Test.Hspec.HUnit () import Test.Hspec.Expectations -import qualified Test.Hspec.Core as Core - --- | Combine a list of specs into a larger spec. -describe :: String -> Spec -> Spec -describe label action = fromSpecList [Core.describe label [BuildSpecs $ runSpecM action]] - --- | An alias for `describe`. -context :: String -> Spec -> Spec -context = describe - --- | Create a spec item. --- --- A spec item consists of: --- --- * a textual description of a desired behavior --- --- * an example for that behavior --- --- > describe "absolute" $ do --- > it "returns a positive number when given a negative number" $ --- > absolute (-1) == 1 -it :: Example a => String -> a -> Spec -it label action = fromSpecList [Core.it label action] --- | This is a type restricted version of `id`. It can be used to get better +-- | @example@ is a type restricted version of `id`. It can be used to get better -- error messages on type mismatches. -- -- Compare e.g. @@ -76,18 +65,10 @@ example :: Expectation -> Expectation example = id --- | Run examples of given spec in parallel. -parallel :: Spec -> Spec -parallel = mapSpecItem $ \item -> item {itemIsParallelizable = True} - --- | Run a custom action before every spec item. -before :: IO () -> Spec -> Spec -before action = around (action >>) - --- | Run a custom action after every spec item. -after :: IO () -> Spec -> Spec -after action = around (`finally` action) - --- | Run a custom action before and/or after every spec item. -around :: (IO () -> IO ()) -> Spec -> Spec -around a2 = mapSpecItem $ \item -> item {itemExample = \params a1 -> itemExample item params (a1 . a2)} +-- | @context@ is an alias for `describe`. +context :: String -> SpecWith a -> SpecWith a +context = describe + +-- | @specify@ is an alias for `it`. +specify :: Example a => String -> a -> SpecWith (Arg a) +specify = it diff -Nru haskell-hspec-1.11.0/test/doctests.hs haskell-hspec-2.1.5/test/doctests.hs --- haskell-hspec-1.11.0/test/doctests.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/doctests.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,6 +0,0 @@ -module Main where - -import Test.DocTest - -main :: IO () -main = doctest ["-isrc", "-optP-include", "-optPdist/build/autogen/cabal_macros.h", "src/Test/Hspec/Util.hs", "src/Test/Hspec/Formatters.hs"] diff -Nru haskell-hspec-1.11.0/test/Helper.hs haskell-hspec-2.1.5/test/Helper.hs --- haskell-hspec-1.11.0/test/Helper.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Helper.hs 2015-03-21 14:58:23.000000000 +0000 @@ -1,86 +1,17 @@ module Helper ( module Test.Hspec.Meta -, module Test.QuickCheck -, module Control.Applicative -, module System.IO.Silently -, sleep -, timeout -, defaultParams -, noOpProgressCallback -, captureLines -, normalizeSummary - -, ignoreExitCode -, ignoreUserInterrupt - -, shouldStartWith -, shouldEndWith - -, shouldUseArgs +, withFileContent ) where -import Data.List -import Data.Char -import Data.IORef -import Control.Monad -import Control.Applicative -import System.Environment (withArgs) -import System.Exit -import Control.Concurrent -import qualified Control.Exception as E -import qualified System.Timeout as System -import Data.Time.Clock.POSIX -import System.IO.Silently - +import Control.Exception (finally) +import System.Directory +import System.IO import Test.Hspec.Meta -import Test.QuickCheck hiding (Result(..)) - -import qualified Test.Hspec as H -import qualified Test.Hspec.Core as H (Params(..), Item(..), ProgressCallback, mapSpecItem) -import qualified Test.Hspec.Runner as H -import Test.Hspec.Core.QuickCheckUtil (mkGen) - -ignoreExitCode :: IO () -> IO () -ignoreExitCode action = action `E.catch` \e -> let _ = e :: ExitCode in return () - -ignoreUserInterrupt :: IO () -> IO () -ignoreUserInterrupt action = E.catchJust (guard . (== E.UserInterrupt)) action return - -captureLines :: IO a -> IO [String] -captureLines = fmap lines . capture_ - -shouldStartWith :: (Eq a, Show a) => [a] -> [a] -> Expectation -x `shouldStartWith` y = x `shouldSatisfy` isPrefixOf y - -shouldEndWith :: (Eq a, Show a) => [a] -> [a] -> Expectation -x `shouldEndWith` y = x `shouldSatisfy` isSuffixOf y - --- replace times in summary with zeroes -normalizeSummary :: [String] -> [String] -normalizeSummary xs = map f xs - where - f x | "Finished in " `isPrefixOf` x = map g x - | otherwise = x - g x | isNumber x = '0' - | otherwise = x - -defaultParams :: H.Params -defaultParams = H.Params stdArgs {replay = Just (mkGen 23, 0)} (H.configSmallCheckDepth H.defaultConfig) - -noOpProgressCallback :: H.ProgressCallback -noOpProgressCallback _ = return () - -sleep :: POSIXTime -> IO () -sleep = threadDelay . floor . (* 1000000) - -timeout :: POSIXTime -> IO a -> IO (Maybe a) -timeout = System.timeout . floor . (* 1000000) -shouldUseArgs :: [String] -> (Args -> Bool) -> Expectation -shouldUseArgs args p = do - spy <- newIORef (H.paramsQuickCheckArgs defaultParams) - let interceptArgs item = item {H.itemExample = \params action progressCallback -> writeIORef spy (H.paramsQuickCheckArgs params) >> H.itemExample item params action progressCallback} - spec = H.mapSpecItem interceptArgs $ - H.it "foo" False - (silence . ignoreExitCode . withArgs args . H.hspec) spec - readIORef spy >>= (`shouldSatisfy` p) +withFileContent :: String -> (FilePath -> IO a) -> IO a +withFileContent input action = do + dir <- getTemporaryDirectory + (file, h) <- openTempFile dir "temp" + hPutStr h input + hClose h + action file `finally` removeFile file diff -Nru haskell-hspec-1.11.0/test/HelperSpec.hs haskell-hspec-2.1.5/test/HelperSpec.hs --- haskell-hspec-1.11.0/test/HelperSpec.hs 1970-01-01 00:00:00.000000000 +0000 +++ haskell-hspec-2.1.5/test/HelperSpec.hs 2015-03-21 14:58:23.000000000 +0000 @@ -0,0 +1,18 @@ +module HelperSpec (main, spec) where + +import Helper +import System.IO.Error (isDoesNotExistError) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "withFileContent" $ do + it "creates a file with specified content and runs specified action" $ do + withFileContent "foo" $ \file -> do + readFile file `shouldReturn` "foo" + + it "removes file after action has been run" $ do + file <- withFileContent "foo" return + readFile file `shouldThrow` isDoesNotExistError diff -Nru haskell-hspec-1.11.0/test/Mock.hs haskell-hspec-2.1.5/test/Mock.hs --- haskell-hspec-1.11.0/test/Mock.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Mock.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,15 +0,0 @@ -module Mock where - -import Control.Applicative -import Data.IORef - -newtype Mock = Mock (IORef Int) - -newMock :: IO Mock -newMock = Mock <$> newIORef 0 - -mockAction :: Mock -> IO () -mockAction (Mock ref) = modifyIORef ref succ - -mockCounter :: Mock -> IO Int -mockCounter (Mock ref) = readIORef ref diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/CompatSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/CompatSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/CompatSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/CompatSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,33 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -module Test.Hspec.CompatSpec (main, spec) where - -import Helper -import System.SetEnv - -import Test.Hspec.Compat -import Data.Typeable - -data SomeType = SomeType - deriving Typeable - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "showType" $ do - it "shows unqualified name of type" $ do - showType SomeType `shouldBe` "SomeType" - - describe "showFullType (currently unused)" $ do - it "shows fully qualified name of type" $ do - showFullType SomeType `shouldBe` "Test.Hspec.CompatSpec.SomeType" - - describe "lookupEnv" $ do - it "returns value of specified environment variable" $ do - setEnv "FOO" "bar" - lookupEnv "FOO" `shouldReturn` Just "bar" - - it "returns Nothing if specified environment variable is not set" $ do - unsetEnv "FOO" - lookupEnv "FOO" `shouldReturn` Nothing diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/Core/QuickCheckUtilSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/Core/QuickCheckUtilSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/Core/QuickCheckUtilSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/Core/QuickCheckUtilSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,31 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-missing-fields #-} -module Test.Hspec.Core.QuickCheckUtilSpec (main, spec) where - -import Helper - -import Test.QuickCheck -import Test.Hspec.Core.QuickCheckUtil - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "formatNumbers" $ do - it "includes number of tests" $ do - formatNumbers (failure 1 0) `shouldBe` "(after 1 test)" - - it "pluralizes number of tests" $ do - formatNumbers (failure 3 0) `shouldBe` "(after 3 tests)" - - it "includes number of shrinks" $ do - formatNumbers (failure 3 1) `shouldBe` "(after 3 tests and 1 shrink)" - - it "pluralizes number of shrinks" $ do - formatNumbers (failure 3 3) `shouldBe` "(after 3 tests and 3 shrinks)" - where - failure tests shrinks = Failure { - numTests = tests - , numShrinks = shrinks - } diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/Core/TypeSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/Core/TypeSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/Core/TypeSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/Core/TypeSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,144 +0,0 @@ -{-# LANGUAGE CPP #-} -module Test.Hspec.Core.TypeSpec (main, spec) where - -import Helper -import Mock -import Data.List -import Data.IORef - -import qualified Test.Hspec.Core.Type as H hiding (describe, it) -import qualified Test.Hspec as H -import qualified Test.Hspec.Runner as H - -main :: IO () -main = hspec spec - -evaluateExample :: H.Example e => e -> IO H.Result -evaluateExample e = H.evaluateExample e defaultParams id noOpProgressCallback - -evaluateExampleWith :: H.Example e => (IO () -> IO ()) -> e -> IO H.Result -evaluateExampleWith action e = H.evaluateExample e defaultParams action noOpProgressCallback - -spec :: Spec -spec = do - describe "evaluateExample" $ do - context "for Bool" $ do - it "returns Success on True" $ do - evaluateExample True `shouldReturn` H.Success - - it "returns Fail on False" $ do - evaluateExample False `shouldReturn` H.Fail "" - - it "propagates exceptions" $ do - evaluateExample (error "foobar" :: Bool) `shouldThrow` errorCall "foobar" - - context "for Expectation" $ do - it "returns Success if all expectations hold" $ do - evaluateExample (23 `shouldBe` (23 :: Int)) `shouldReturn` H.Success - - it "returns Fail if an expectation does not hold" $ do - evaluateExample (23 `shouldBe` (42 :: Int)) `shouldReturn` H.Fail "expected: 42\n but got: 23" - - it "propagates exceptions" $ do - evaluateExample (error "foobar" :: Expectation) `shouldThrow` errorCall "foobar" - - it "runs provided action around expectation" $ do - ref <- newIORef (0 :: Int) - let action :: IO () -> IO () - action e = do - n <- readIORef ref - e - readIORef ref `shouldReturn` succ n - modifyIORef ref succ - evaluateExampleWith action (modifyIORef ref succ) `shouldReturn` H.Success - readIORef ref `shouldReturn` 2 - - context "when used with `pending`" $ do - it "returns Pending" $ do - evaluateExample (H.pending) `shouldReturn` H.Pending Nothing - - context "when used with `pendingWith`" $ do - it "includes the optional reason" $ do - evaluateExample (H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo") - - context "for Property" $ do - it "returns Success if property holds" $ do - evaluateExample (property $ \n -> n == (n :: Int)) `shouldReturn` H.Success - - it "returns Fail if property does not hold" $ do - H.Fail _ <- evaluateExample $ property $ \n -> n /= (n :: Int) - return () - - it "shows what falsified it" $ do - H.Fail r <- evaluateExample $ property $ \x y -> x + y == (x * y :: Int) - r `shouldBe` intercalate "\n" [ -#if MIN_VERSION_QuickCheck(2,7,0) - "Falsifiable (after 2 tests and 2 shrinks): " -#else - "Falsifiable (after 1 test and 3 shrinks): " -#endif - , "0" - , "1" - ] - - it "runs provided action around each single check of the property" $ do - ref <- newIORef (0 :: Int) - let action :: IO () -> IO () - action e = do - n <- readIORef ref - e - readIORef ref `shouldReturn` succ n - modifyIORef ref succ - H.Success <- evaluateExampleWith action (property $ modifyIORef ref succ) - readIORef ref `shouldReturn` 200 - - it "pretty-prints exceptions" $ do - -- pendingWith "this probably needs a patch to QuickCheck" - evaluateExample (property $ (error "foobar" :: Int -> Bool)) `shouldReturn` (H.Fail . intercalate "\n") [ -#if MIN_VERSION_QuickCheck(2,7,0) - "uncaught exception: ErrorCall (foobar) (after 1 test)" -#else - "Exception: 'foobar' (after 1 test and 2 shrinks): " -#endif - , "0" - ] - - context "when used with shouldBe" $ do - it "shows what falsified it" $ do - H.Fail r <- evaluateExample $ property $ \x y -> x + y `shouldBe` (x * y :: Int) - r `shouldBe` intercalate "\n" [ -#if MIN_VERSION_QuickCheck(2,7,0) - "Falsifiable (after 2 tests and 2 shrinks): " -#else - "Falsifiable (after 1 test and 3 shrinks): " -#endif - , "expected: 0" - , " but got: 1" - , "0" - , "1" - ] - - context "when used with `pending`" $ do - it "returns Pending" $ do - evaluateExample (property H.pending) `shouldReturn` H.Pending Nothing - - context "when used with `pendingWith`" $ do - it "includes the optional reason" $ do - evaluateExample (property $ H.pendingWith "foo") `shouldReturn` H.Pending (Just "foo") - - describe "Expectation" $ do - context "as a QuickCheck property" $ do - it "can be quantified" $ do - e <- newMock - silence . H.hspec $ do - H.it "some behavior" $ property $ \xs -> do - mockAction e - (reverse . reverse) xs `shouldBe` (xs :: [Int]) - mockCounter e `shouldReturn` 100 - - it "can be used with expectations/HUnit assertions" $ do - silence . H.hspecResult $ do - H.describe "readIO" $ do - H.it "is inverse to show" $ property $ \x -> do - (readIO . show) x `shouldReturn` (x :: Int) - `shouldReturn` H.Summary 1 0 diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/DiscoverSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/DiscoverSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/DiscoverSpec.hs 1970-01-01 00:00:00.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/DiscoverSpec.hs 2015-03-21 14:58:23.000000000 +0000 @@ -0,0 +1,71 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-deprecations #-} +module Test.Hspec.DiscoverSpec (main, spec) where + +import Helper +import Data.String +import Data.String.Builder + +import qualified Test.Hspec.Core.Spec as H +import Test.Hspec.Core (Tree(..), Item(..), Location(..), LocationAccuracy(..), runSpecM) +import qualified Test.Hspec.Discover as H + +infix 1 `shouldHaveLocation` + +shouldHaveLocation :: Item a -> (String, Int) -> Expectation +item `shouldHaveLocation` (src, line) = itemLocation item `shouldBe` Just (Location src line 0 BestEffort) + +main :: IO () +main = hspec spec + +spec :: Spec +spec = do + describe "postProcessSpec" $ do + it "adds heuristic source locations" $ do + let c = build $ do + "" + strlit "foo" + "" + strlit "bar" + "" + strlit "baz" + withFileContent c $ \src -> do + [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src $ do + H.it "foo" True + H.it "bar" True + H.it "baz" True + item1 `shouldHaveLocation` (src, 2) + item2 `shouldHaveLocation` (src, 4) + item3 `shouldHaveLocation` (src, 6) + + context "when same requirement is used multiple times" $ do + it "assigns locations sequentially" $ do + let c = build $ do + strlit "foo" + strlit "foo" + strlit "foo" + withFileContent c $ \src -> do + [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src $ do + H.it "foo" True + H.it "foo" True + H.it "foo" True + item1 `shouldHaveLocation` (src, 1) + item2 `shouldHaveLocation` (src, 2) + item3 `shouldHaveLocation` (src, 3) + + context "when a requirement occurs more often in the spec tree than in the source file" $ do + it "assigns Nothing" $ do + let c = build $ do + strlit "foo" + strlit "foo" + withFileContent c $ \src -> do + [Leaf item1, Leaf item2, Leaf item3] <- runSpecM . H.postProcessSpec src $ do + H.it "foo" True + H.it "foo" True + H.it "foo" True + itemLocation item1 `shouldBe` Nothing + itemLocation item2 `shouldBe` Nothing + itemLocation item3 `shouldBe` Nothing + where + strlit :: String -> Builder + strlit = fromString . show diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/FailureReportSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/FailureReportSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/FailureReportSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/FailureReportSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,39 +0,0 @@ -module Test.Hspec.FailureReportSpec (main, spec) where - -import Helper - -import System.IO -import Test.Hspec.FailureReport -import GHC.Paths (ghc) -import System.Process -import System.Exit - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "writeFailureReport" $ do - it "prints a warning on unexpected exceptions" $ do - r <- hCapture_ [stderr] $ writeFailureReport (error "some error") - r `shouldBe` "WARNING: Could not write environment variable HSPEC_FAILURES (some error)\n" - - -- GHCi needs to keep the environment on :reload, so that we can store - -- failures there. Otherwise --rerun would not be very useful. So we add a - -- test for that. - describe "GHCi" $ do - it "keeps environment variables on :reload" $ do - let flags = ["-v0", "--interactive", "-ignore-dot-ghci"] - (Just hIn, Just hOut, Nothing, processHandle) <- createProcess $ (proc ghc flags) { - std_in = CreatePipe - , std_out = CreatePipe - } - hPutStrLn hIn "import System.SetEnv" - hPutStrLn hIn "setEnv \"FOO\" \"bar\"" - hPutStrLn hIn ":reload" - hPutStrLn hIn "import System.Environment" - hPutStrLn hIn "getEnv \"FOO\"" - hClose hIn - r <- hGetContents hOut - length r `seq` r `shouldBe` "\"bar\"\n" - waitForProcess processHandle `shouldReturn` ExitSuccess diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/FormattersSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/FormattersSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/FormattersSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/FormattersSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,220 +0,0 @@ -{-# LANGUAGE CPP #-} -module Test.Hspec.FormattersSpec (main, spec) where - -import Helper - -import qualified Test.Hspec as H -import qualified Test.Hspec.Core as H (Result(..)) -import qualified Test.Hspec.Runner as H -import qualified Test.Hspec.Formatters as H - -#ifndef mingw32_HOST_OS -import System.Console.ANSI -#endif - -main :: IO () -main = hspec spec - -testSpec :: H.Spec -testSpec = do - H.describe "Example" $ do - H.it "success" (H.Success) - H.it "fail 1" (H.Fail "fail message") - H.it "pending" (H.pendingWith "pending message") - H.it "fail 2" (H.Fail "") - H.it "exceptions" (undefined :: H.Result) - H.it "fail 3" (H.Fail "") - -spec :: Spec -spec = do - describe "silent" $ do - let runSpec = fmap fst . capture . H.hspecWith H.defaultConfig {H.configFormatter = H.silent} - it "produces no output" $ do - runSpec testSpec `shouldReturn` "" - - describe "failed_examples" $ do - failed_examplesSpec H.failed_examples - - describe "progress" $ do - let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = H.progress} - - it "produces '..F...FF.F' style output" $ do - r <- runSpec testSpec - head r `shouldBe` ".F.FFF" - - context "same as failed_examples" $ do - failed_examplesSpec H.progress - - describe "specdoc" $ do - let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = H.specdoc} - - it "displays a header for each thing being described" $ do - _:x:_ <- runSpec testSpec - x `shouldBe` "Example" - - it "displays one row for each behavior" $ do - r <- runSpec $ do - H.describe "List as a Monoid" $ do - H.describe "mappend" $ do - H.it "is associative" True - H.describe "mempty" $ do - H.it "is a left identity" True - H.it "is a right identity" True - H.describe "Maybe as a Monoid" $ do - H.describe "mappend" $ do - H.it "is associative" True - H.describe "mempty" $ do - H.it "is a left identity" True - H.it "is a right identity" True - normalizeSummary r `shouldBe` [ - "" - , "List as a Monoid" - , " mappend" - , " - is associative" - , "" - , " mempty" - , " - is a left identity" - , " - is a right identity" - , "" - , "Maybe as a Monoid" - , " mappend" - , " - is associative" - , "" - , " mempty" - , " - is a left identity" - , " - is a right identity" - , "" - , "Finished in 0.0000 seconds" - , "6 examples, 0 failures" - ] - - it "prints an empty line before each group" $ do - r <- runSpec $ do - H.describe "foo" $ do - H.it "example 1" True - H.it "example 2" True - H.describe "bar" $ do - H.it "example 3" True - H.it "example 4" True - normalizeSummary r `shouldBe` [ - "" - , "foo" - , " - example 1" - , " - example 2" - , "" - , " bar" - , " - example 3" - , " - example 4" - , "" - , "Finished in 0.0000 seconds" - , "4 examples, 0 failures" - ] - - it "prints an empty line after each group" $ do - r <- runSpec $ do - H.describe "foo" $ do - H.describe "bar" $ do - H.it "example 1" True - H.it "example 2" True - H.it "example 3" True - H.it "example 4" True - normalizeSummary r `shouldBe` [ - "" - , "foo" - , " bar" - , " - example 1" - , " - example 2" - , "" - , " - example 3" - , " - example 4" - , "" - , "Finished in 0.0000 seconds" - , "4 examples, 0 failures" - ] - - it "outputs an empty line at the beginning (even for non-nested specs)" $ do - r <- runSpec $ do - H.it "example 1" True - H.it "example 2" True - normalizeSummary r `shouldBe` [ - "" - , "- example 1" - , "- example 2" - , "" - , "Finished in 0.0000 seconds" - , "2 examples, 0 failures" - ] - - it "displays a row for each successfull, failed, or pending example" $ do - r <- runSpec testSpec - r `shouldSatisfy` any (== " - fail 1 FAILED [1]") - r `shouldSatisfy` any (== " - success") - - it "displays a '#' with an additional message for pending examples" $ do - r <- runSpec testSpec - r `shouldSatisfy` any (== " # PENDING: pending message") - - context "same as failed_examples" $ do - failed_examplesSpec H.progress - -failed_examplesSpec :: H.Formatter -> Spec -failed_examplesSpec formatter = do - let runSpec = captureLines . H.hspecWith H.defaultConfig {H.configFormatter = formatter} - - it "summarizes the time it takes to finish" $ do - r <- runSpec (return ()) - normalizeSummary r `shouldSatisfy` any (== "Finished in 0.0000 seconds") - - context "displays a detailed list of failures" $ do - it "prints all requirements that are not met" $ do - r <- runSpec testSpec - r `shouldSatisfy` any (== "1) Example fail 1") - - it "prints the exception type for requirements that fail due to an uncaught exception" $ do - r <- runSpec $ do - H.it "foobar" (undefined :: Bool) - r `shouldContain` [ - "1) foobar" - , "uncaught exception: ErrorCall (Prelude.undefined)" - ] - - it "prints all descriptions when a nested requirement fails" $ do - r <- runSpec $ - H.describe "foo" $ do - H.describe "bar" $ do - H.it "baz" False - r `shouldSatisfy` any (== "1) foo.bar baz") - - it "summarizes the number of examples and failures" $ do - r <- runSpec testSpec - r `shouldSatisfy` any (== "6 examples, 4 failures, 1 pending") - - -- Windows has no support for ANSI escape codes. The Console API is used for - -- colorized output, hence the following tests do not work on Windows. -#ifndef mingw32_HOST_OS - it "shows summary in green if there are no failures" $ do - r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do - H.it "foobar" True - r `shouldSatisfy` any (== (green ++ "1 example, 0 failures" ++ reset)) - - it "shows summary in yellow if there are pending examples" $ do - r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do - H.it "foobar" H.pending - r `shouldSatisfy` any (== (yellow ++ "1 example, 0 failures, 1 pending" ++ reset)) - - it "shows summary in red if there are failures" $ do - r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do - H.it "foobar" False - r `shouldSatisfy` any (== (red ++ "1 example, 1 failure" ++ reset)) - - it "shows summary in red if there are both failures and pending examples" $ do - r <- captureLines $ H.hspecWith H.defaultConfig {H.configColorMode = H.ColorAlways} $ do - H.it "foo" False - H.it "bar" H.pending - r `shouldSatisfy` any (== (red ++ "2 examples, 1 failure, 1 pending" ++ reset)) - where - green = setSGRCode [SetColor Foreground Dull Green] - yellow = setSGRCode [SetColor Foreground Dull Yellow] - red = setSGRCode [SetColor Foreground Dull Red] - reset = setSGRCode [Reset] -#endif diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/HUnitSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/HUnitSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/HUnitSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/HUnitSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,40 +0,0 @@ -module Test.Hspec.HUnitSpec (main, spec) where - -import Helper hiding (example) - -import Test.Hspec.Runner.Tree -import Test.Hspec.HUnit -import Test.HUnit - -main :: IO () -main = hspec spec - -shouldYield :: Test -> [Tree ()] -> Expectation -a `shouldYield` b = map (() <$) <$> toTree (fromHUnitTest a) `shouldReturn` b - -spec :: Spec -spec = do - describe "fromHUnitTest" $ do - let e = TestCase $ pure () - - it "works for a TestCase" $ do - e `shouldYield` [example ""] - - it "works for a labeled TestCase" $ do - TestLabel "foo" e - `shouldYield` [example "foo"] - - it "works for a TestCase with nested labels" $ do - (TestLabel "foo" . TestLabel "bar") e - `shouldYield` [Node "foo" [example "bar"]] - - it "works for a flat TestList" $ do - TestList [e, e, e] - `shouldYield` [example "", example "", example ""] - - it "works for a nested TestList" $ do - (TestLabel "foo" . TestLabel "bar" . TestList) [TestLabel "one" e, TestLabel "two" e, TestLabel "three" e] - `shouldYield` [Node "foo" [Node "bar" [example "one", example "two", example "three"]]] - where - example :: String -> Tree () - example r = Leaf r () diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/OptionsSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/OptionsSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/OptionsSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/OptionsSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,44 +0,0 @@ -module Test.Hspec.OptionsSpec (main, spec) where - -import Helper -import System.Exit - -import Test.Hspec.Options hiding (parseOptions) -import qualified Test.Hspec.Options as Options - -main :: IO () -main = hspec spec - -fromLeft :: Either a b -> a -fromLeft (Left a) = a -fromLeft _ = error "fromLeft: No left value!" - -spec :: Spec -spec = do - describe "parseOptions" $ do - - let parseOptions = Options.parseOptions defaultOptions "my-spec" - - it "sets optionsColorMode to ColorAuto" $ do - optionsColorMode <$> parseOptions [] `shouldBe` Right ColorAuto - - context "with --no-color" $ do - it "sets optionsColorMode to ColorNever" $ do - optionsColorMode <$> parseOptions ["--no-color"] `shouldBe` Right ColorNever - - context "with --color" $ do - it "sets optionsColorMode to ColorAlways" $ do - optionsColorMode <$> parseOptions ["--color"] `shouldBe` Right ColorAlways - - context "with --out" $ do - it "sets optionsOutputFile" $ do - optionsOutputFile <$> parseOptions ["--out", "foo"] `shouldBe` Right (Just "foo") - - context "with --qc-max-success" $ do - context "when given an invalid argument" $ do - it "returns an error message" $ do - fromLeft (parseOptions ["--qc-max-success", "foo"]) `shouldBe` (ExitFailure 1, "my-spec: invalid argument `foo' for `--qc-max-success'\nTry `my-spec --help' for more information.\n") - - context "with --depth" $ do - it "sets depth parameter for SmallCheck" $ do - optionsDepth <$> parseOptions ["--depth", "23"] `shouldBe` Right (Just 23) diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/QuickCheckSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/QuickCheckSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/QuickCheckSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/QuickCheckSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,19 +0,0 @@ -module Test.Hspec.QuickCheckSpec (main, spec) where - -import Helper - -import qualified Test.Hspec as H -import qualified Test.Hspec.Runner as H -import qualified Test.Hspec.QuickCheck as H - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "prop" $ do - it "is a shortcut to use properties as examples" $ do - silence . H.hspecResult $ do - H.describe "read" $ do - H.prop "is inverse to show" $ \x -> (read . show) x == (x :: Int) - `shouldReturn` H.Summary 1 0 diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/RunnerSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/RunnerSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/RunnerSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/RunnerSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,401 +0,0 @@ -{-# LANGUAGE CPP #-} -module Test.Hspec.RunnerSpec (main, spec) where - -import Helper -import System.IO (stderr) -import Control.Monad -import System.Environment (withArgs, withProgName, getArgs) -import System.Exit -import Control.Concurrent -import qualified Control.Exception as E -import Mock -import System.SetEnv -import Test.Hspec.Compat - -import Test.Hspec.FailureReport (FailureReport(..)) -import qualified Test.Hspec as H -import qualified Test.Hspec.Runner as H -import qualified Test.Hspec.Core as H (Result(..)) -import qualified Test.Hspec.Formatters as H (silent) - -import qualified Test.QuickCheck as QC - -main :: IO () -main = hspec spec - -quickCheckOptions :: [([Char], Args -> Int)] -quickCheckOptions = [("--qc-max-success", QC.maxSuccess), ("--qc-max-size", QC.maxSize), ("--qc-max-discard", QC.maxDiscardRatio)] - -prop_foo :: Integer -> Bool -prop_foo = (/= 26) - -runPropFoo :: [String] -> IO String -runPropFoo args = fmap (unlines . normalizeSummary . lines) . capture_ . ignoreExitCode . withArgs args . H.hspec $ H.it "foo" $ property prop_foo - -prop_foo_result_with_seed_42 :: String -prop_foo_result_with_seed_42 = unlines [ -#if MIN_VERSION_QuickCheck(2,7,0) - "Falsifiable (after 31 tests): " -#else - "Falsifiable (after 30 tests): " -#endif - , "26" - ] - -spec :: Spec -spec = do - describe "hspec" $ do - it "runs a spec" $ do - silence . H.hspec $ do - H.it "foobar" True - `shouldReturn` () - - it "exits with exitFailure if not all examples pass" $ do - silence . H.hspec $ do - H.it "foobar" False - `shouldThrow` (== ExitFailure 1) - - it "allows output to stdout" $ do - r <- captureLines . H.hspec $ do - H.it "foobar" $ do - putStrLn "baz" - r `shouldSatisfy` elem "baz" - - it "prints an error message on unrecognized command-line options" $ do - withProgName "myspec" . withArgs ["--foo"] $ do - hSilence [stderr] (H.hspec $ pure ()) `shouldThrow` (== ExitFailure 1) - fst `fmap` hCapture [stderr] (ignoreExitCode (H.hspec $ pure ())) `shouldReturn` unlines [ - "myspec: unrecognized option `--foo'" - , "Try `myspec --help' for more information." - ] - - it "stores a failure report in the environment" $ do - silence . ignoreExitCode . withArgs ["--seed", "23"] . H.hspec $ do - H.describe "foo" $ do - H.describe "bar" $ do - H.it "example 1" True - H.it "example 2" False - H.describe "baz" $ do - H.it "example 3" False - lookupEnv "HSPEC_FAILURES" `shouldReturn` (Just . show) FailureReport { - failureReportSeed = 23 - , failureReportMaxSuccess = 100 - , failureReportMaxSize = 100 - , failureReportMaxDiscardRatio = 10 - , failureReportPaths = [ - (["foo", "bar"], "example 2") - , (["baz"], "example 3") - ] - } - - describe "with --rerun" $ do - let runSpec = (captureLines . ignoreExitCode . H.hspec) $ do - H.it "example 1" True - H.it "example 2" False - H.it "example 3" False - H.it "example 4" True - H.it "example 5" False - - it "reruns examples that previously failed" $ do - r0 <- runSpec - r0 `shouldSatisfy` elem "5 examples, 3 failures" - - r1 <- withArgs ["--rerun"] runSpec - r1 `shouldSatisfy` elem "3 examples, 3 failures" - - it "reuses the same seed" $ do - r <- runPropFoo ["--seed", "42"] - runPropFoo ["-r"] `shouldReturn` r - - forM_ quickCheckOptions $ \(flag, accessor) -> do - it ("reuses same " ++ flag) $ do - [flag, "23"] `shouldUseArgs` ((== 23) . accessor) - ["--rerun"] `shouldUseArgs` ((== 23) . accessor) - - context "when there is no failure report in the environment" $ do - it "runs everything" $ do - unsetEnv "HSPEC_FAILURES" - r <- hSilence [stderr] $ withArgs ["-r"] runSpec - r `shouldSatisfy` elem "5 examples, 3 failures" - - it "prints a warning to stderr" $ do - unsetEnv "HSPEC_FAILURES" - r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec - r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" - - context "when parsing of failure report fails" $ do - it "runs everything" $ do - setEnv "HSPEC_FAILURES" "some invalid report" - r <- hSilence [stderr] $ withArgs ["-r"] runSpec - r `shouldSatisfy` elem "5 examples, 3 failures" - - it "prints a warning to stderr" $ do - setEnv "HSPEC_FAILURES" "some invalid report" - r <- hCapture_ [stderr] $ withArgs ["-r"] runSpec - r `shouldBe` "WARNING: Could not read environment variable HSPEC_FAILURES; `--rerun' is ignored!\n" - - - it "does not leak command-line flags to examples" $ do - silence . withArgs ["--verbose"] $ do - H.hspec $ do - H.it "foobar" $ do - getArgs `shouldReturn` [] - `shouldReturn` () - - context "when interrupted with ctrl-c" $ do - it "prints summary immediately" $ do - mvar <- newEmptyMVar - sync <- newEmptyMVar - threadId <- forkIO $ do - r <- captureLines . ignoreUserInterrupt . withArgs ["--seed", "23"] . H.hspec $ do - H.it "foo" False - H.it "bar" $ do - putMVar sync () - threadDelay 1000000 - H.it "baz" True - putMVar mvar r - takeMVar sync - throwTo threadId E.UserInterrupt - r <- takeMVar mvar - normalizeSummary r `shouldBe` [ - "" - , "- foo FAILED [1]" - , "" - , "1) foo" - , "" - , "Randomized with seed 23" - , "" - ] - - it "throws UserInterrupt" $ do - mvar <- newEmptyMVar - sync <- newEmptyMVar - threadId <- forkIO $ do - silence . H.hspec $ do - H.it "foo" $ do - putMVar sync () - threadDelay 1000000 - `E.catch` putMVar mvar - takeMVar sync - throwTo threadId E.UserInterrupt - takeMVar mvar `shouldReturn` E.UserInterrupt - - context "with --help" $ do - let printHelp = withProgName "spec" . withArgs ["--help"] . H.hspec $ pure () - it "prints help" $ do - r <- (captureLines . ignoreExitCode) printHelp - r `shouldStartWith` ["Usage: spec [OPTION]..."] - silence printHelp `shouldThrow` (== ExitSuccess) - - it "constrains lines to 80 characters" $ do - r <- (captureLines . ignoreExitCode) printHelp - r `shouldSatisfy` all ((<= 80) . length) - r `shouldSatisfy` any ((78 <=) . length) - - context "with --dry-run" $ do - it "produces a report" $ do - r <- captureLines . withArgs ["--dry-run"] . H.hspec $ do - H.it "foo" True - H.it "bar" True - normalizeSummary r `shouldBe` [ - "" - , "- foo" - , "- bar" - , "" - , "Finished in 0.0000 seconds" - , "2 examples, 0 failures" - ] - - it "does not verify anything" $ do - e <- newMock - _ <- captureLines . withArgs ["--dry-run"] . H.hspec $ do - H.it "foo" (mockAction e) - H.it "bar" False - mockCounter e `shouldReturn` 0 - - context "with --fail-fast" $ do - it "stops after first failure" $ do - r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do - H.it "foo" True - H.it "bar" False - H.it "baz" False - normalizeSummary r `shouldBe` [ - "" - , "- foo" - , "- bar FAILED [1]" - , "" - , "1) bar" - , "" - , "Randomized with seed 23" - , "" - , "Finished in 0.0000 seconds" - , "2 examples, 1 failure" - ] - - it "works for nested specs" $ do - r <- captureLines . ignoreExitCode . withArgs ["--fail-fast", "--seed", "23"] . H.hspec $ do - H.describe "foo" $ do - H.it "bar" False - H.it "baz" True - normalizeSummary r `shouldBe` [ - "" - , "foo" - , " - bar FAILED [1]" - , "" - , "1) foo bar" - , "" - , "Randomized with seed 23" - , "" - , "Finished in 0.0000 seconds" - , "1 example, 1 failure" - ] - - context "with --match" $ do - it "only runs examples that match a given pattern" $ do - e1 <- newMock - e2 <- newMock - e3 <- newMock - silence . withArgs ["-m", "/bar/example"] . H.hspec $ do - H.describe "foo" $ do - H.describe "bar" $ do - H.it "example 1" $ mockAction e1 - H.it "example 2" $ mockAction e2 - H.describe "baz" $ do - H.it "example 3" $ mockAction e3 - (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 1, 0) - - it "can be given multiple times" $ do - e1 <- newMock - e2 <- newMock - e3 <- newMock - silence . withArgs ["-m", "foo", "-m", "baz"] . H.hspec $ do - H.describe "foo" $ do - H.it "example 1" $ mockAction e1 - H.describe "bar" $ do - H.it "example 2" $ mockAction e2 - H.describe "baz" $ do - H.it "example 3" $ mockAction e3 - (,,) <$> mockCounter e1 <*> mockCounter e2 <*> mockCounter e3 `shouldReturn` (1, 0, 1) - - context "with --format" $ do - it "uses specified formatter" $ do - r <- capture_ . ignoreExitCode . withArgs ["--format", "progress"] . H.hspec $ do - H.it "foo" True - H.it "bar" True - H.it "baz" False - H.it "qux" True - r `shouldContain` "..F." - - context "when given an invalid argument" $ do - it "prints an error message to stderr" $ do - r <- hCapture_ [stderr] . ignoreExitCode . withArgs ["--format", "foo"] . H.hspec $ do - H.it "foo" True - r `shouldContain` "invalid argument `foo' for `--format'" - - context "with --qc-max-success" $ do - it "tries QuickCheck properties specified number of times" $ do - m <- newMock - silence . withArgs ["--qc-max-success", "23"] . H.hspec $ do - H.it "foo" $ property $ do - mockAction m - mockCounter m `shouldReturn` 23 - - context "when run with --rerun" $ do - it "takes precedence" $ do - ["--qc-max-success", "23"] `shouldUseArgs` ((== 23) . QC.maxSuccess) - ["--rerun", "--qc-max-success", "42"] `shouldUseArgs` ((== 42) . QC.maxSuccess) - - context "with --qc-max-size" $ do - it "passes specified size to QuickCheck properties" $ do - ["--qc-max-size", "23"] `shouldUseArgs` ((== 23) . QC.maxSize) - - context "with --qc-max-discard" $ do - it "uses specified discard ratio to QuickCheck properties" $ do - ["--qc-max-discard", "23"] `shouldUseArgs` ((== 23) . QC.maxDiscardRatio) - - context "with --seed" $ do - it "uses specified seed" $ do - r <- runPropFoo ["--seed", "42"] - r `shouldContain` prop_foo_result_with_seed_42 - - context "when run with --rerun" $ do - it "takes precedence" $ do - r <- runPropFoo ["--seed", "23"] - _ <- runPropFoo ["--seed", "42"] - runPropFoo ["--rerun", "--seed", "23"] `shouldReturn` r - - context "when given an invalid argument" $ do - let run = withArgs ["--seed", "foo"] . H.hspec $ do - H.it "foo" True - it "prints an error message to stderr" $ do - r <- hCapture_ [stderr] (ignoreExitCode run) - r `shouldContain` "invalid argument `foo' for `--seed'" - - it "exits with exitFailure" $ do - hSilence [stderr] run `shouldThrow` (== ExitFailure 1) - - context "with --print-cpu-time" $ do - it "includes used CPU time in summary" $ do - r <- capture_ $ withArgs ["--print-cpu-time"] (H.hspec $ pure ()) - (normalizeSummary . lines) r `shouldContain` ["Finished in 0.0000 seconds, used 0.0000 seconds of CPU time"] - - context "with --html" $ do - it "produces HTML output" $ do - r <- capture_ . withArgs ["--html"] . H.hspec $ do - H.it "foo" True - r `shouldContain` "" - - it "marks successful examples with CSS class hspec-success" $ do - r <- capture_ . withArgs ["--html"] . H.hspec $ do - H.it "foo" True - r `shouldContain` "- foo\n" - - it "marks pending examples with CSS class hspec-pending" $ do - r <- capture_ . withArgs ["--html"] . H.hspec $ do - H.it "foo" H.pending - r `shouldContain` "- foo" - - it "marks failed examples with CSS class hspec-failure" $ do - r <- capture_ . ignoreExitCode . withArgs ["--html"] . H.hspec $ do - H.it "foo" False - r `shouldContain` "- foo" - - describe "hspecResult" $ do - it "returns a summary of the test run" $ do - silence . H.hspecResult $ do - H.it "foo" True - H.it "foo" False - H.it "foo" False - H.it "foo" True - H.it "foo" True - `shouldReturn` H.Summary 5 2 - - it "treats uncaught exceptions as failure" $ do - silence . H.hspecResult $ do - H.it "foobar" (E.throwIO (E.ErrorCall "foobar") >> pure ()) - `shouldReturn` H.Summary 1 1 - - it "uses the specdoc formatter by default" $ do - _:r:_ <- captureLines . H.hspecResult $ do - H.describe "Foo.Bar" $ do - H.it "some example" True - r `shouldBe` "Foo.Bar" - - it "can use a custom formatter" $ do - r <- capture_ . H.hspecWith H.defaultConfig {H.configFormatter = H.silent} $ do - H.describe "Foo.Bar" $ do - H.it "some example" True - r `shouldBe` "" - - it "does not let escape error thunks from failure messages" $ do - r <- silence . H.hspecResult $ do - H.it "some example" (H.Fail $ "foobar" ++ undefined) - r `shouldBe` H.Summary 1 1 - - it "runs specs in parallel" $ do - let n = 10 - t = 0.01 - dt = t * (fromIntegral n / 2) - r <- timeout dt . silence . H.hspecResult . H.parallel $ do - replicateM_ n (H.it "foo" $ sleep t) - r `shouldBe` Just (H.Summary n 0) diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/TimerSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/TimerSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/TimerSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/TimerSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,29 +0,0 @@ -module Test.Hspec.TimerSpec (main, spec) where - -import Helper - -import Test.Hspec.Timer - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "timer action returned by newTimer" $ do - - let dt = 0.01 - - it "returns False" $ do - timer <- newTimer dt - timer `shouldReturn` False - - context "after specified time" $ do - it "returns True" $ do - timer <- newTimer dt - sleep dt - timer `shouldReturn` True - timer `shouldReturn` False - sleep dt - sleep dt - timer `shouldReturn` True - timer `shouldReturn` False diff -Nru haskell-hspec-1.11.0/test/Test/Hspec/UtilSpec.hs haskell-hspec-2.1.5/test/Test/Hspec/UtilSpec.hs --- haskell-hspec-1.11.0/test/Test/Hspec/UtilSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/Hspec/UtilSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,97 +0,0 @@ -module Test.Hspec.UtilSpec (main, spec) where - -import Helper -import Control.Concurrent -import qualified Control.Exception as E - -import Test.Hspec.Util - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "pluralize" $ do - it "returns an amount and a word given an amount and word" $ do - pluralize 1 "thing" `shouldBe` "1 thing" - - it "returns a singular word given the number 1" $ do - pluralize 1 "thing" `shouldBe` "1 thing" - - it "returns a plural word given a number greater than 1" $ do - pluralize 2 "thing" `shouldBe` "2 things" - - it "returns a plural word given the number 0" $ do - pluralize 0 "thing" `shouldBe` "0 things" - - describe "lineBreaksAt" $ do - it "inserts line breaks at word boundaries" $ do - lineBreaksAt 20 "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod" - `shouldBe` [ - "Lorem ipsum dolor" - , "sit amet," - , "consectetur" - , "adipisicing elit," - , "sed do eiusmod" - ] - - describe "safeTry" $ do - it "returns Right on success" $ do - Right e <- safeTry (return 23 :: IO Int) - e `shouldBe` 23 - - it "returns Left on exception" $ do - Left e <- safeTry (E.throwIO E.DivideByZero :: IO Int) - show e `shouldBe` "divide by zero" - - it "evaluates result to weak head normal form" $ do - Left e <- safeTry (return undefined) - show e `shouldBe` "Prelude.undefined" - - it "does not catch asynchronous exceptions" $ do - mvar <- newEmptyMVar - sync <- newEmptyMVar - threadId <- forkIO $ do - safeTry (putMVar sync () >> threadDelay 1000000) >> return () - `E.catch` putMVar mvar - takeMVar sync - throwTo threadId E.UserInterrupt - readMVar mvar `shouldReturn` E.UserInterrupt - - describe "filterPredicate" $ do - it "tries to match a pattern against a path" $ do - let p = filterPredicate "foo/bar/example 1" - p (["foo", "bar"], "example 1") `shouldBe` True - p (["foo", "bar"], "example 2") `shouldBe` False - - it "is ambiguous" $ do - let p = filterPredicate "foo/bar/baz" - p (["foo", "bar"], "baz") `shouldBe` True - p (["foo"], "bar/baz") `shouldBe` True - - it "succeeds on a partial match" $ do - let p = filterPredicate "bar/baz" - p (["foo", "bar", "baz"], "example 1") `shouldBe` True - - it "succeeds with a pattern that matches the message give in the failure list" $ do - let p = filterPredicate "ModuleA.ModuleB.foo does something" - p (["ModuleA", "ModuleB", "foo"], "does something") `shouldBe` True - - describe "formatRequirement" $ do - it "creates a sentence from a subject and a requirement" $ do - formatRequirement (["reverse"], "reverses a list") `shouldBe` "reverse reverses a list" - - it "creates a sentence from a subject and a requirement when the subject consits of multiple words" $ do - formatRequirement (["The reverse function"], "reverses a list") `shouldBe` "The reverse function reverses a list" - - it "returns the requirement if no subject is given" $ do - formatRequirement ([], "reverses a list") `shouldBe` "reverses a list" - - it "inserts context separated by commas" $ do - formatRequirement (["reverse", "when applied twice"], "reverses a list") `shouldBe` "reverse, when applied twice, reverses a list" - - it "joins components of a subject with a dot" $ do - formatRequirement (["Data", "List", "reverse"], "reverses a list") `shouldBe` "Data.List.reverse reverses a list" - - it "properly handles context after a subject that consists of several components" $ do - formatRequirement (["Data", "List", "reverse", "when applied twice"], "reverses a list") `shouldBe` "Data.List.reverse, when applied twice, reverses a list" diff -Nru haskell-hspec-1.11.0/test/Test/HspecSpec.hs haskell-hspec-2.1.5/test/Test/HspecSpec.hs --- haskell-hspec-1.11.0/test/Test/HspecSpec.hs 2014-07-22 09:02:21.000000000 +0000 +++ haskell-hspec-2.1.5/test/Test/HspecSpec.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,148 +0,0 @@ -module Test.HspecSpec (main, spec) where - -import Helper -import Mock -import Data.IORef -import Data.List (isPrefixOf) - -import Test.Hspec.Core (Item(..), Result(..)) -import qualified Test.Hspec as H -import qualified Test.Hspec.Runner as H (hspecResult) - -import Test.Hspec.Runner.Tree - -main :: IO () -main = hspec spec - -spec :: Spec -spec = do - describe "pending" $ do - it "specifies a pending example" $ do - r <- runSpec $ do - H.it "foo" H.pending - r `shouldSatisfy` any (== " # PENDING: No reason given") - - describe "pendingWith" $ do - it "specifies a pending example with a reason for why it's pending" $ do - r <- runSpec $ do - H.it "foo" $ do - H.pendingWith "for some reason" - r `shouldSatisfy` any (== " # PENDING: for some reason") - - describe "describe" $ do - let testSpec = do - H.describe "some subject" $ do - H.it "foo" True - H.it "bar" True - H.it "baz" True - it "takes a description of what the behavior is for" $ do - r <- runSpec testSpec - r `shouldSatisfy` any (== "some subject") - - it "groups behaviors for what's being described" $ do - r <- filter (isPrefixOf " - ") `fmap` runSpec testSpec - length r `shouldBe` 3 - - it "can be nested" $ do - [Node foo [Node bar [Leaf baz _]]] <- toTree $ do - H.describe "foo" $ do - H.describe "bar" $ do - H.it "baz" True - (foo, bar, baz) `shouldBe` ("foo", "bar", "baz") - - context "when no description is given" $ do - it "uses a default description" $ do - [Node d _] <- toTree (H.describe "" (pure ())) - d `shouldBe` "(no description given)" - - describe "it" $ do - it "takes a description of a desired behavior" $ do - [Leaf requirement _] <- toTree (H.it "whatever" True) - requirement `shouldBe` "whatever" - - it "takes an example of that behavior" $ do - [Leaf _ item] <- toTree (H.it "whatever" True) - itemExample item defaultParams id noOpProgressCallback `shouldReturn` Success - - context "when no description is given" $ do - it "uses a default description" $ do - [Leaf requirement _] <- toTree (H.it "" True) - requirement `shouldBe` "(unspecified behavior)" - - describe "example" $ do - it "fixes the type of an expectation" $ do - r <- runSpec $ do - H.it "foo" $ H.example $ do - pure () - r `shouldSatisfy` any (== "1 example, 0 failures") - - describe "parallel" $ do - it "marks examples for parallel execution" $ do - [Leaf _ item] <- toTree . H.parallel $ H.it "whatever" True - itemIsParallelizable item `shouldBe` True - - it "is applied recursively" $ do - [Node _ [Node _ [Leaf _ item]]] <- toTree . H.parallel $ do - H.describe "foo" $ do - H.describe "bar" $ do - H.it "baz" True - itemIsParallelizable item `shouldBe` True - - describe "before" $ do - it "runs an action before each spec item" $ do - mock <- newMock - silence $ H.hspec $ H.before (mockAction mock) $ do - H.it "foo" $ do - mockCounter mock `shouldReturn` 1 - H.it "bar" $ do - mockCounter mock `shouldReturn` 2 - mockCounter mock `shouldReturn` 2 - - context "when used multiple times" $ do - it "is evaluated outside in" $ do - ref <- newIORef (0 :: Int) - let action1 = do - readIORef ref `shouldReturn` 0 - modifyIORef ref succ - action2 = do - readIORef ref `shouldReturn` 1 - modifyIORef ref succ - silence $ H.hspec $ H.before action1 $ H.before action2 $ do - H.it "foo" $ do - readIORef ref `shouldReturn` 2 - - describe "after" $ do - it "runs an action after each spec item" $ do - mock <- newMock - silence $ H.hspec $ H.after (mockAction mock) $ do - H.it "foo" $ do - mockCounter mock `shouldReturn` 0 - H.it "bar" $ do - mockCounter mock `shouldReturn` 1 - mockCounter mock `shouldReturn` 2 - - it "guarantees that action is run" $ do - mock <- newMock - silence . ignoreExitCode $ H.hspec $ H.after (mockAction mock) $ do - H.it "foo" $ do - ioError $ userError "foo" :: IO () - mockCounter mock `shouldReturn` 1 - - describe "around" $ do - it "wraps each spec item with an action" $ do - ref <- newIORef (0 :: Int) - let action :: IO () -> IO () - action e = do - readIORef ref `shouldReturn` 0 - writeIORef ref 1 - e - readIORef ref `shouldReturn` 2 - writeIORef ref 3 - silence $ H.hspec $ H.around action $ do - H.it "foo" $ do - readIORef ref `shouldReturn` 1 - writeIORef ref 2 - readIORef ref `shouldReturn` 3 - where - runSpec :: H.Spec -> IO [String] - runSpec = captureLines . H.hspecResult