diff --git a/Test/Tasty/Hspec.hs b/Test/Tasty/Hspec.hs --- a/Test/Tasty/Hspec.hs +++ b/Test/Tasty/Hspec.hs @@ -1,5 +1,6 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE InstanceSigs #-} module Test.Tasty.Hspec ( -- * Test @@ -17,24 +18,28 @@ , module Test.Hspec ) where -import Control.Applicative ((<$>)) -import Data.Proxy -import Data.Typeable (Typeable) -import qualified Test.Hspec as H -import qualified Test.Hspec.Core.Spec as H -import qualified Test.QuickCheck as QC -import qualified Test.Tasty as T +import Control.Applicative ((<$>)) +import Data.Proxy +import Data.Tagged (Tagged) +import Data.Typeable (Typeable) + +import qualified Test.Hspec as H +import qualified Test.Hspec.Core.Formatters as H +import qualified Test.Hspec.Core.Spec as H +import qualified Test.QuickCheck as QC +import qualified Test.Tasty as T import qualified Test.Tasty.SmallCheck as TSC -import qualified Test.Tasty.Options as T -import qualified Test.Tasty.Providers as T +import qualified Test.Tasty.Options as T +import qualified Test.Tasty.Providers as T import qualified Test.Tasty.QuickCheck as TQC -import qualified Test.Tasty.Runners as T +import qualified Test.Tasty.Runners as T -- For re-export. import Test.Hspec import Test.Tasty.SmallCheck (SmallCheckDepth(..)) -import Test.Tasty.QuickCheck (QuickCheckMaxRatio(..), QuickCheckMaxSize(..) - , QuickCheckReplay(..), QuickCheckTests(..)) +import Test.Tasty.QuickCheck + (QuickCheckMaxRatio(..), QuickCheckMaxSize(..), QuickCheckReplay(..), + QuickCheckTests(..)) -- | Create a 'T.TestTree' from an -- 'H.Spec'. @@ -49,61 +54,84 @@ testSpecs spec = map specTreeToTestTree <$> H.runSpecM spec specTreeToTestTree :: H.SpecTree () -> T.TestTree -specTreeToTestTree (H.Node name spec_trees) = T.testGroup name (map specTreeToTestTree spec_trees) +specTreeToTestTree (H.Node name spec_trees) = + T.testGroup name (map specTreeToTestTree spec_trees) specTreeToTestTree (H.NodeWithCleanup cleanup spec_trees) = - let test_tree = specTreeToTestTree (H.Node "(unnamed)" spec_trees) - in T.WithResource (T.ResourceSpec (return ()) cleanup) (const test_tree) + T.WithResource (T.ResourceSpec (return ()) cleanup) (const test_tree) + where + test_tree :: T.TestTree + test_tree = specTreeToTestTree (H.Node "(unnamed)" spec_trees) specTreeToTestTree (H.Leaf item) = T.singleTest (H.itemRequirement item) (Item item) -hspecResultToTastyResult :: H.Result -> T.Result -hspecResultToTastyResult H.Success = T.testPassed "" -hspecResultToTastyResult (H.Pending mstr) = T.testFailed ("test pending" ++ maybe "" (": " ++) mstr) -#if MIN_VERSION_hspec(2,2,0) -hspecResultToTastyResult (H.Fail _ str) = T.testFailed str -#else -hspecResultToTastyResult (H.Fail str) = T.testFailed str -#endif - newtype Item = Item (H.Item ()) deriving Typeable instance T.IsTest Item where - run opts (Item (H.Item _ _ _ ex)) progress = - hspecResultToTastyResult <$> ex params ($ ()) hprogress - where - params :: H.Params - params = H.Params - { H.paramsQuickCheckArgs = qc_args - , H.paramsSmallCheckDepth = sc_depth - } - where - qc_args :: QC.Args - qc_args = - let TQC.QuickCheckTests num_tests = T.lookupOption opts - TQC.QuickCheckReplay replay = T.lookupOption opts - TQC.QuickCheckMaxSize max_size = T.lookupOption opts - TQC.QuickCheckMaxRatio max_ratio = T.lookupOption opts - in QC.stdArgs - { QC.chatty = False - , QC.maxDiscardRatio = max_ratio - , QC.maxSize = max_size - , QC.maxSuccess = num_tests - , QC.replay = replay - } + run :: T.OptionSet -> Item -> (T.Progress -> IO ()) -> IO T.Result + run opts (Item (H.Item _ _ _ ex)) progress = +#if MIN_VERSION_hspec(2,4,0) + either (T.testFailed . H.formatException) hspecResultToTastyResult +#else + hspecResultToTastyResult +#endif + <$> ex params ($ ()) hprogress + where + params :: H.Params + params = H.Params + { H.paramsQuickCheckArgs = qc_args + , H.paramsSmallCheckDepth = sc_depth + } + where + qc_args :: QC.Args + qc_args = QC.stdArgs + { QC.chatty = False + , QC.maxDiscardRatio = max_ratio + , QC.maxSize = max_size + , QC.maxSuccess = num_tests + , QC.replay = replay + } + where + TQC.QuickCheckTests num_tests = T.lookupOption opts + TQC.QuickCheckReplay replay = T.lookupOption opts + TQC.QuickCheckMaxSize max_size = T.lookupOption opts + TQC.QuickCheckMaxRatio max_ratio = T.lookupOption opts - sc_depth :: Int - sc_depth = let TSC.SmallCheckDepth depth = T.lookupOption opts in depth + sc_depth :: Int + sc_depth = depth + where + TSC.SmallCheckDepth depth = T.lookupOption opts - hprogress :: H.Progress -> IO () - hprogress (x,y) = progress $ T.Progress - { T.progressText = "" - , T.progressPercent = fromIntegral x / fromIntegral y - } + hprogress :: H.Progress -> IO () + hprogress (x,y) = progress (T.Progress + { T.progressText = "" + , T.progressPercent = fromIntegral x / fromIntegral y + }) - testOptions = return - [ T.Option (Proxy :: Proxy TQC.QuickCheckTests) - , T.Option (Proxy :: Proxy TQC.QuickCheckReplay) - , T.Option (Proxy :: Proxy TQC.QuickCheckMaxSize) - , T.Option (Proxy :: Proxy TQC.QuickCheckMaxRatio) - , T.Option (Proxy :: Proxy TSC.SmallCheckDepth) + testOptions :: Tagged Item [T.OptionDescription] + testOptions = return + [ T.Option (Proxy :: Proxy TQC.QuickCheckTests) + , T.Option (Proxy :: Proxy TQC.QuickCheckReplay) + , T.Option (Proxy :: Proxy TQC.QuickCheckMaxSize) + , T.Option (Proxy :: Proxy TQC.QuickCheckMaxRatio) + , T.Option (Proxy :: Proxy TSC.SmallCheckDepth) + ] + +hspecResultToTastyResult :: H.Result -> T.Result +hspecResultToTastyResult H.Success = T.testPassed "" +hspecResultToTastyResult (H.Pending mstr) = T.testFailed ("Test pending" ++ maybe "" (": " ++) mstr) +#if MIN_VERSION_hspec(2,4,0) +hspecResultToTastyResult (H.Failure _ reason) = + case reason of + H.NoReason -> T.testFailed "" + H.Reason str -> T.testFailed str + H.ExpectedButGot preface expected actual -> + T.testFailed $ mconcat + [ maybe "" (++ ": ") preface + , "expected " ++ expected + , ", but got " ++ actual ] +#elif MIN_VERSION_hspec(2,2,0) +hspecResultToTastyResult (H.Fail _ str) = T.testFailed str +#else +hspecResultToTastyResult (H.Fail str) = T.testFailed str +#endif diff --git a/tasty-hspec.cabal b/tasty-hspec.cabal --- a/tasty-hspec.cabal +++ b/tasty-hspec.cabal @@ -1,7 +1,8 @@ name: tasty-hspec -version: 1.1.3 +version: 1.1.3.1 synopsis: Hspec support for the Tasty test framework. -description: Hspec support for the Tasty test framework. +description: This package provides a Tasty provider for Hspec test + suites. homepage: https://github.com/mitchellwrosen/tasty-hspec license: BSD3 @@ -20,8 +21,8 @@ exposed-modules: Test.Tasty.Hspec other-extensions: DeriveDataTypeable build-depends: base ==4.* - , hspec >=2 && <2.3 - , hspec-core >=2 && <3 + , hspec >=2 && <2.5 + , hspec-core >=2 && <2.5 , QuickCheck >=2.7 , tagged >=0.7 , tasty >=0.8