sydtest 0.9.0.0 → 0.10.0.0
raw patch · 7 files changed
+60/−34 lines, 7 filesdep −yaml
Dependencies removed: yaml
Files
- CHANGELOG.md +7/−0
- output-test/Spec.hs +2/−0
- src/Test/Syd/Expectation.hs +1/−1
- src/Test/Syd/OptParse.hs +19/−10
- src/Test/Syd/Output.hs +10/−5
- src/Test/Syd/Run.hs +19/−15
- sydtest.cabal +2/−3
CHANGELOG.md view
@@ -1,5 +1,12 @@ # Changelog +## [0.10.0.0] - 2022-04-28++### Added++* Allow supplying filters without a flag, so `hello` instead of `--filter hello` or `--match hello`.+* Simplified the way exceptions work to allow for attaching context to any failure instead of only `Assertion`s.+ ## [0.9.0.0] - 2022-04-13 ### Added
output-test/Spec.hs view
@@ -204,6 +204,8 @@ context "Context2" $ context "Context3" $ True `shouldBe` False+ it "shows a context when an exception is thrown as well" $+ context "context" (undefined :: IO ()) modifyMaxSize (`div` 10) $ describe "Property" $ do describe "0 tests run" $ modifyMaxSuccess (const 0) $ it "shows a red '0 tests' when no tests are run" $ property $ \b -> b `shouldBe` False
src/Test/Syd/Expectation.hs view
@@ -127,7 +127,7 @@ -- This is a completely different function from the function with the same name in hspec. -- In hspec, context is a synonym for describe, but in sydtest, context is used for contextual failures. context :: String -> IO a -> IO a-context s action = (action >>= evaluate) `catch` (\a -> throwIO (Context a s))+context s action = (action >>= evaluate) `catch` (\e -> throwIO (addContextToException (e :: SomeException) s)) -- | For easy hspec migration type Expectation = IO ()
src/Test/Syd/OptParse.hs view
@@ -542,16 +542,25 @@ <*> doubleSwitch ["golden-start"] (help "Whether to write golden tests if they do not exist yet") <*> doubleSwitch ["golden-reset"] (help "Whether to overwrite golden tests instead of having them fail") <*> doubleSwitch ["colour", "color"] (help "Use colour in output")- <*> optional- ( strOption- ( mconcat- [ long "filter",- long "match",- help "Filter to select which parts of the test tree to run",- metavar "FILTER"- ]- )- )+ <*> ( optional+ ( strArgument+ ( mconcat+ [ help "Filter to select which parts of the test tree to run",+ metavar "FILTER"+ ]+ )+ )+ <|> optional+ ( strOption+ ( mconcat+ [ long "filter",+ long "match",+ help "Filter to select which parts of the test tree to run",+ metavar "FILTER"+ ]+ )+ )+ ) <*> doubleSwitch ["fail-fast"] (help "Stop upon the first test failure") <*> optional ( ( ( \case
src/Test/Syd/Output.hs view
@@ -7,6 +7,7 @@ module Test.Syd.Output where +import Control.Exception import Control.Monad.Reader import Data.Algorithm.Diff import Data.ByteString.Builder (Builder)@@ -384,15 +385,19 @@ map (padFailureDetails . (\c -> [chunk "Generated: ", c]) . fore yellow . chunk . T.pack) testRunResultFailingInputs, map padFailureDetails $ outputFailureLabels testRunResultLabels, map padFailureDetails $ outputFailureClasses testRunResultClasses,- map padFailureDetails $- case testRunResultException of- Nothing -> []- Just (Left s) -> stringChunks s- Just (Right a) -> outputAssertion a,+ map padFailureDetails $ maybe [] outputSomeException testRunResultException, [padFailureDetails $ outputGoldenCase gc | gc <- maybeToList testRunResultGoldenCase], concat [map padFailureDetails $ stringChunks ei | ei <- maybeToList testRunResultExtraInfo], [[chunk ""]] ]++outputSomeException :: SomeException -> [[Chunk]]+outputSomeException se =+ case fromException se of+ Just (Contextual se' s) -> outputSomeException se' ++ stringChunks s+ Nothing -> case fromException se of+ Just a -> outputAssertion a+ Nothing -> stringChunks $ displayException se outputAssertion :: Assertion -> [[Chunk]] outputAssertion = \case
src/Test/Syd/Run.hs view
@@ -95,7 +95,7 @@ forall r outerArgs innerArg. ((outerArgs -> innerArg -> IO ()) -> IO ()) -> (outerArgs -> innerArg -> IO r) ->- IO (Either (Either String Assertion) r)+ IO (Either SomeException r) applyWrapper2 wrapper func = do var <- liftIO newEmptyMVar r <- (`catches` exceptionHandlers) $@@ -105,7 +105,7 @@ liftIO $ putMVar var res case r of Right () -> liftIO $ readMVar var- Left e -> pure (Left e :: Either (Either String Assertion) r)+ Left e -> pure (Left e :: Either SomeException r) instance IsTest (IO ()) where type Arg1 (IO ()) = ()@@ -247,9 +247,7 @@ let testRunResultStatus = TestFailed let testRunResultException = do se <- theException qcr- pure $ case fromException se of- Just a -> Right a- Nothing -> Left $ displayException se+ pure (se :: SomeException) let testRunResultNumShrinks = Just $ fromIntegral $ numShrinks qcr let testRunResultFailingInputs = failingTestCase qcr let testRunResultExtraInfo = Nothing@@ -350,12 +348,12 @@ Nothing -> if testRunSettingGoldenStart then do- actual <- goldenTestProduce+ actual <- goldenTestProduce >>= evaluate goldenTestWrite actual pure (TestPassed, Just GoldenStarted, Nothing) else pure (TestFailed, Just GoldenNotFound, Nothing) Just golden -> do- actual <- goldenTestProduce+ actual <- goldenTestProduce >>= evaluate case goldenTestCompare actual golden of Nothing -> pure (TestPassed, Nothing, Nothing) Just assertion ->@@ -363,7 +361,7 @@ then do goldenTestWrite actual pure (TestPassed, Just GoldenReset, Nothing)- else pure (TestFailed, Nothing, Just $ Right assertion)+ else pure (TestFailed, Nothing, Just $ SomeException assertion) let (testRunResultStatus, testRunResultGoldenCase, testRunResultException) = case errOrTrip of Left e -> (TestFailed, Nothing, Just e) Right trip -> trip@@ -378,14 +376,12 @@ let testRunResultFlakinessMessage = Nothing pure TestRunResult {..} -exceptionHandlers :: [Handler (Either (Either String Assertion) a)]+exceptionHandlers :: [Handler (Either SomeException a)] exceptionHandlers = [ -- Re-throw AsyncException, otherwise execution will not terminate on SIGINT (ctrl-c). Handler (\e -> throwIO (e :: AsyncException)),- -- Catch assertions first because we know what to do with them.- Handler $ \(a :: Assertion) -> pure (Left $ Right a),- -- Catch all the rest as a string- Handler (\e -> return $ Left (Left (displayException (e :: SomeException))))+ -- Catch all the rest+ Handler (\e -> return $ Left (e :: SomeException)) ] type Test = IO ()@@ -431,7 +427,7 @@ data TestRunResult = TestRunResult { testRunResultStatus :: !TestStatus, testRunResultRetries :: !(Maybe Int),- testRunResultException :: !(Maybe (Either String Assertion)),+ testRunResultException :: !(Maybe SomeException), testRunResultNumTests :: !(Maybe Word), testRunResultNumShrinks :: !(Maybe Word), testRunResultFailingInputs :: [String],@@ -442,7 +438,7 @@ testRunResultExtraInfo :: !(Maybe String), testRunResultFlakinessMessage :: !(Maybe String) }- deriving (Show, Eq, Generic)+ deriving (Show, Generic) data TestStatus = TestPassed | TestFailed deriving (Show, Eq, Generic)@@ -466,6 +462,14 @@ deriving (Show, Eq, Typeable, Generic) instance Exception Assertion++data Contextual = Contextual !SomeException !String+ deriving (Show, Typeable, Generic)++instance Exception Contextual++addContextToException :: Exception e => e -> String -> Contextual+addContextToException e = Contextual (SomeException e) data GoldenCase = GoldenNotFound
sydtest.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.6.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack name: sydtest-version: 0.9.0.0+version: 0.10.0.0 synopsis: A modern testing framework for Haskell with good defaults and advanced testing features. description: A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category: Testing@@ -86,7 +86,6 @@ , split , stm , text- , yaml if os(windows) build-depends: ansi-terminal