hspec-junit-formatter 1.1.2.1 → 1.3.0.0
raw patch · 17 files changed
Files
- README.lhs +14/−1
- README.md +14/−1
- hspec-junit-formatter.cabal +67/−93
- library/Test/Hspec/JUnit.hs +0/−226
- library/Test/Hspec/JUnit/Config.hs +39/−28
- library/Test/Hspec/JUnit/Config/Env.hs +6/−5
- library/Test/Hspec/JUnit/Format.hs +179/−117
- library/Test/Hspec/JUnit/Formatter.hs +4/−5
- library/Test/Hspec/JUnit/Formatter/Env.hs +1/−1
- library/Test/Hspec/JUnit/Render.hs +197/−94
- library/Test/Hspec/JUnit/Schema.hs +185/−28
- tests/Example.hs +1/−1
- tests/Test/Hspec/JUnit/FormatterSpec.hs +310/−91
- tests/golden/default-ghc-8.xml +0/−69
- tests/golden/default-ghc-9.xml +0/−6
- tests/golden/prefixed-ghc-8.xml +0/−69
- tests/golden/prefixed-ghc-9.xml +0/−69
README.lhs view
@@ -13,7 +13,6 @@ module Main (main) where import Prelude-import Text.Markdown.Unlit () -- Used in a later example import qualified Test.Hspec.JUnit.Formatter.Env as FormatterEnv@@ -119,6 +118,20 @@ We maintain specific golden XML files for GHC 8.x vs 9.x, so you will need to re-run the test suite with at least one of each series to regenerate all the necessary files.++## Release++To trigger a release, merge a commit to `main` that follows [Conventional+Commits][]. In short,++- `fix:` to trigger a patch release+- `feat:` to trigger a minor release+- `<type>!:` or use a `BREAKING CHANGE:` footer to trigger a major release++We don't enforce conventional commits generally (though you are free do so),+it's only required if you want to trigger release.++[conventional commits]: https://www.conventionalcommits.org/en/v1.0.0/#summary ---
README.md view
@@ -13,7 +13,6 @@ module Main (main) where import Prelude-import Text.Markdown.Unlit () -- Used in a later example import qualified Test.Hspec.JUnit.Formatter.Env as FormatterEnv@@ -119,6 +118,20 @@ We maintain specific golden XML files for GHC 8.x vs 9.x, so you will need to re-run the test suite with at least one of each series to regenerate all the necessary files.++## Release++To trigger a release, merge a commit to `main` that follows [Conventional+Commits][]. In short,++- `fix:` to trigger a patch release+- `feat:` to trigger a minor release+- `<type>!:` or use a `BREAKING CHANGE:` footer to trigger a major release++We don't enforce conventional commits generally (though you are free do so),+it's only required if you want to trigger release.++[conventional commits]: https://www.conventionalcommits.org/en/v1.0.0/#summary ---
hspec-junit-formatter.cabal view
@@ -1,25 +1,19 @@-cabal-version: 1.18-name: hspec-junit-formatter-version: 1.1.2.1-license: MIT-license-file: LICENSE-copyright: 2021 Renaissance Learning Inc-maintainer: engineering@freckle.com-author: Freckle R&D-homepage: https://github.com/freckle/hspec-junit-formatter#readme-bug-reports: https://github.com/freckle/hspec-junit-formatter/issues-synopsis: A JUnit XML runner/formatter for hspec+cabal-version: 1.18+name: hspec-junit-formatter+version: 1.3.0.0+license: MIT+license-file: LICENSE+copyright: 2021 Renaissance Learning Inc+maintainer: engineering@freckle.com+author: Freckle R&D+homepage: https://github.com/freckle/hspec-junit-formatter#readme+bug-reports: https://github.com/freckle/hspec-junit-formatter/issues+synopsis: A JUnit XML runner/formatter for hspec description: Allows hspec tests to write JUnit XML output for parsing in various tools. -category: Testing-build-type: Simple-extra-source-files:- tests/golden/default-ghc-8.xml- tests/golden/default-ghc-9.xml- tests/golden/prefixed-ghc-8.xml- tests/golden/prefixed-ghc-9.xml-+category: Testing+build-type: Simple extra-doc-files: README.md CHANGELOG.md@@ -30,7 +24,6 @@ library exposed-modules:- Test.Hspec.JUnit Test.Hspec.JUnit.Config Test.Hspec.JUnit.Config.Env Test.Hspec.JUnit.Format@@ -41,87 +34,75 @@ hs-source-dirs: library other-modules: Paths_hspec_junit_formatter- default-language: Haskell2010+ default-language: GHC2021 default-extensions:- BangPatterns DeriveAnyClass DeriveFoldable DeriveFunctor- DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies- FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving- LambdaCase MultiParamTypeClasses NoImplicitPrelude- NoMonomorphismRestriction OverloadedStrings RankNTypes- RecordWildCards ScopedTypeVariables StandaloneDeriving- TypeApplications TypeFamilies+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction NoPostfixOperators+ OverloadedRecordDot OverloadedStrings QuasiQuotes TypeFamilies ghc-options:- -fignore-optim-changes -Weverything -Wno-all-missed-specialisations+ -Weverything -Wno-all-missed-specialisations -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-local-signatures- -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe build-depends:- array >=0.5.2.0,- base >=4.11.1.0 && <5,- conduit >=1.3.1,- containers >=0.5.11.0,- directory >=1.3.1.5,- exceptions >=0.10.0,- filepath >=1.4.2,+ array >=0.5.4.0,+ base >=4.16.4.0 && <5,+ conduit >=1.3.5,+ directory >=1.3.6.2,+ filepath >=1.4.2.2, hspec-api >=2.10.0, hspec-core >=2.10.0, iso8601-time >=0.1.5,+ mtl >=2.2.2, regex-base >=0.94.0.2,- regex-tdfa >=1.3.2.2,- text >=1.2.3.1,- time >=1.8.0.2,- xml-conduit >=1.8.0.1,- xml-types >=0.3.6+ regex-tdfa >=1.3.2.1,+ semigroups >=0.20,+ text >=1.2.5.0,+ time >=1.11.1.1,+ xml-conduit >=1.10.0.0,+ xml-types >=0.3.8 + if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations+ if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures - if impl(ghc >=8.10)- ghc-options:- -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module-- if impl(ghc >=8.8)- ghc-options: -fwrite-ide-info- test-suite readme type: exitcode-stdio-1.0 main-is: README.lhs+ build-tool-depends: markdown-unlit:markdown-unlit other-modules: Paths_hspec_junit_formatter- default-language: Haskell2010+ default-language: GHC2021 default-extensions:- BangPatterns DeriveAnyClass DeriveFoldable DeriveFunctor- DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies- FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving- LambdaCase MultiParamTypeClasses NoImplicitPrelude- NoMonomorphismRestriction OverloadedStrings RankNTypes- RecordWildCards ScopedTypeVariables StandaloneDeriving- TypeApplications TypeFamilies+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction NoPostfixOperators+ OverloadedRecordDot OverloadedStrings QuasiQuotes TypeFamilies ghc-options:- -fignore-optim-changes -Weverything -Wno-all-missed-specialisations+ -Weverything -Wno-all-missed-specialisations -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-local-signatures- -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -pgmL+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -pgmL markdown-unlit build-depends:- base >=4.11.1.0 && <5,+ base >=4.16.4.0 && <5, hspec >=2.10.0,- hspec-junit-formatter,- markdown-unlit >=0.5.0+ hspec-junit-formatter + if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations+ if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures - if impl(ghc >=8.10)- ghc-options:- -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module-- if impl(ghc >=8.8)- ghc-options: -fwrite-ide-info- test-suite spec type: exitcode-stdio-1.0 main-is: Spec.hs@@ -133,40 +114,33 @@ Test.Hspec.JUnit.FormatterSpec Paths_hspec_junit_formatter - default-language: Haskell2010+ default-language: GHC2021 default-extensions:- BangPatterns DeriveAnyClass DeriveFoldable DeriveFunctor- DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies- FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving- LambdaCase MultiParamTypeClasses NoImplicitPrelude- NoMonomorphismRestriction OverloadedStrings RankNTypes- RecordWildCards ScopedTypeVariables StandaloneDeriving- TypeApplications TypeFamilies+ DataKinds DeriveAnyClass DerivingStrategies DerivingVia+ DuplicateRecordFields GADTs LambdaCase NoFieldSelectors+ NoImplicitPrelude NoMonomorphismRestriction NoPostfixOperators+ OverloadedRecordDot OverloadedStrings QuasiQuotes TypeFamilies ghc-options:- -fignore-optim-changes -Weverything -Wno-all-missed-specialisations+ -Weverything -Wno-all-missed-specialisations -Wno-missed-specialisations -Wno-missing-exported-signatures -Wno-missing-import-lists -Wno-missing-local-signatures- -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -threaded- -rtsopts -O0 -with-rtsopts=-N+ -Wno-missing-safe-haskell-mode -Wno-monomorphism-restriction+ -Wno-prepositive-qualified-module -Wno-safe -Wno-unsafe -threaded+ -rtsopts -with-rtsopts=-N build-depends:- base >=4.11.1.0 && <5,- containers >=0.5.11.0,- filepath >=1.4.2,+ base >=4.16.4.0 && <5,+ filepath >=1.4.2.2, hspec >=2.10.0,- hspec-golden >=0.2.1.0, hspec-junit-formatter,+ iso8601-time >=0.1.5, temporary >=1.3,- text >=1.2.3.1,- xml-conduit >=1.8.0.1+ text >=1.2.5.0,+ xml-conduit >=1.10.0.0 + if impl(ghc >=9.8)+ ghc-options: -Wno-missing-role-annotations+ if impl(ghc >=9.2) ghc-options: -Wno-missing-kind-signatures-- if impl(ghc >=8.10)- ghc-options:- -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module-- if impl(ghc >=8.8)- ghc-options: -fwrite-ide-info
− library/Test/Hspec/JUnit.hs
@@ -1,226 +0,0 @@-{-# LANGUAGE CPP #-}--module Test.Hspec.JUnit- {-# DEPRECATED "Use Test.Hspec.JUnit.Formatter" #-}- ( -- * Runners- hspecJUnit- , hspecJUnitWith-- -- * Directly modifying 'Config'- , configWithJUnit- , configWithJUnitAvailable-- -- * Actual format function- , junitFormat-- -- * Configuration- , module Test.Hspec.JUnit.Config- ) where--import Prelude--import Control.Applicative ((<|>))-import Data.Conduit (runConduitRes, (.|))-import Data.Conduit.Combinators (sinkFile)-import Data.Conduit.List (sourceList)-import Data.Functor ((<&>))-import qualified Data.Map.Strict as Map-import Data.Maybe (fromMaybe)-import Data.Text (Text, pack, unpack)-import qualified Data.Text as T-import Data.Time (getCurrentTime)-import System.Directory (createDirectoryIfMissing)-import System.FilePath (splitFileName)-import Test.Hspec.Core.Format- ( Event (..)- , FailureReason (..)- , Format- , FormatConfig- , Item (..)- , Location (..)- , Path- , Result (..)- , Seconds (..)- )-import Test.Hspec.Core.Runner (Config (..), defaultConfig, hspecWith)-import Test.Hspec.Core.Spec (Spec)-import Test.Hspec.JUnit.Config-import Test.Hspec.JUnit.Config.Env-import Test.Hspec.JUnit.Render (renderJUnit)-import qualified Test.Hspec.JUnit.Schema as Schema-import Text.XML.Stream.Render (def, renderBytes)---- | Like 'hspec' but adds JUNit functionality------ To actually /use/ the JUnit format, you must set @JUNIT_ENABLED=1@ in the--- environment; by default, this function just behaves like 'hspec'.------ Running tests with @--test-arguments="-f junit"@ also works.------ All configuration of the JUnit report occurs through environment variables.------ See "Test.Hspec.JUnit.Config" and "Test.Hspec.JUnit.Config.Env".-hspecJUnit :: Spec -> IO ()-hspecJUnit = hspecJUnitWith defaultConfig---- | 'hspecJUnit' but built on a non-default 'Config'-hspecJUnitWith :: Config -> Spec -> IO ()-hspecJUnitWith config spec = do- junitEnabled <- envJUnitEnabled- junitConfig <- envJUnitConfig-- let- modify = if junitEnabled then configWithJUnit junitConfig else id- base = configWithJUnitAvailable junitConfig config-- hspecWith (modify base) spec---- | Modify an Hspec 'Config' to use 'junitFormat'-configWithJUnit :: JUnitConfig -> Config -> Config-configWithJUnit junitConfig config =- config {configFormat = Just $ junitFormat junitConfig}---- | Modify an Hspec 'Config' to have the 'junitFormat' /available/------ Adds @junit@ to the list of available options for @-f, --format@.-configWithJUnitAvailable :: JUnitConfig -> Config -> Config-configWithJUnitAvailable junitConfig config =- config- { configAvailableFormatters =- configAvailableFormatters config <> [("junit", junitFormat junitConfig)]- }---- | Hspec 'configFormat' that generates a JUnit report-junitFormat :: JUnitConfig -> FormatConfig -> IO Format-junitFormat junitConfig _config = pure $ \case- Started -> pure ()- GroupStarted _ -> pure ()- GroupDone _ -> pure ()- Progress _ _ -> pure ()- ItemStarted _ -> pure ()- ItemDone _ _ -> pure ()- Done paths -> do- time <- getCurrentTime-- let (directory, _) = splitFileName file- createDirectoryIfMissing True directory-- let- groups = groupItems paths- output =- Schema.Suites- { suitesName = suiteName- , suitesSuites =- groups <&> \(group, items) -> do- let suite xs =- Schema.Suite- { suiteName = group- , suiteTimestamp = time- , suiteCases = xs- }- suite $ uncurry (itemToTestCase applyPrefix group) <$> items- }-- runConduitRes $- sourceList [output]- .| renderJUnit dropConsoleFormatting- .| renderBytes def- .| sinkFile file- where- file = getJUnitConfigOutputFile junitConfig- suiteName = getJUnitConfigSuiteName junitConfig- applyPrefix = getJUnitPrefixSourcePath junitConfig- dropConsoleFormatting = getJUnitConfigDropConsoleFormatting junitConfig--groupItems :: [(Path, Item)] -> [(Text, [(Text, Item)])]-groupItems = Map.toList . Map.fromListWith (<>) . fmap group- where- group ((path, name), item) =- (T.intercalate "/" $ pack <$> path, [(pack name, item)])--itemToTestCase- :: (FilePath -> FilePath) -> Text -> Text -> Item -> Schema.TestCase-itemToTestCase applyPrefix group name item =- Schema.TestCase- { testCaseLocation =- toSchemaLocation applyPrefix- <$> (itemResultLocation item <|> itemLocation item)- , testCaseClassName = group- , testCaseName = name- , testCaseDuration = unSeconds $ itemDuration item- , testCaseResult = case itemResult item of- Success -> Nothing- Pending mLocation mMessage ->- Just $- Schema.Skipped $- prefixLocation mLocation $- prefixInfo $- maybe- ""- pack- mMessage- Failure mLocation reason ->- Just $- Schema.Failure "error" $- prefixLocation mLocation $- prefixInfo $- reasonToText reason- }- where- prefixLocation mLocation str = case mLocation of- Nothing -> str- Just Location {..} ->- mconcat- [ pack $ applyPrefix locationFile- , ":"- , pack $ show locationLine- , ":"- , pack $ show locationColumn- , "\n"- ]- <> str- prefixInfo str- | T.null $ T.strip $ pack $ itemInfo item = str- | otherwise = pack (itemInfo item) <> "\n\n" <> str--itemResultLocation :: Item -> Maybe Location-itemResultLocation item = case itemResult item of- Success -> Nothing- Pending mLocation _ -> mLocation- Failure mLocation _ -> mLocation--toSchemaLocation :: (FilePath -> FilePath) -> Location -> Schema.Location-toSchemaLocation applyPrefix Location {..} =- Schema.Location- { Schema.locationFile = applyPrefix locationFile- , Schema.locationLine = fromIntegral $ max 0 locationLine- }--unSeconds :: Seconds -> Double-unSeconds (Seconds x) = x--foundLines :: Show a => Text -> a -> [String]-foundLines msg found = case lines' of- [] -> []- first : rest ->- unpack (msg <> ": " <> first) : (unpack . (T.replicate 9 " " <>) <$> rest)- where- lines' = T.lines . pack $ show found--{- FOURMOLU_DISABLE -}-reasonToText :: FailureReason -> Text-reasonToText = \case- Error _ err -> pack $ show err- NoReason -> "no reason"- Reason err -> pack err-#if MIN_VERSION_hspec_core(2,11,0)- ColorizedReason err -> pack err-#endif- ExpectedButGot preface expected actual ->- T.unlines- $ pack- <$> fromMaybe "" preface- : (foundLines "expected" expected- <> foundLines " but got" actual- )-{- FOURMOLU_ENABLE -}
library/Test/Hspec/JUnit/Config.hs view
@@ -9,12 +9,14 @@ , setJUnitConfigSuiteName , setJUnitConfigSourcePathPrefix , setJUnitConfigDropConsoleFormatting+ , setJUnitConfigPretty -- * Use , getJUnitConfigOutputFile , getJUnitConfigSuiteName , getJUnitPrefixSourcePath , getJUnitConfigDropConsoleFormatting+ , getJUnitConfigPretty ) where import Prelude@@ -24,12 +26,13 @@ import System.FilePath ((</>)) data JUnitConfig = JUnitConfig- { junitConfigOutputDirectory :: FilePath- , junitConfigOutputName :: FilePath- , junitConfigOutputFile :: Maybe FilePath- , junitConfigSuiteName :: Text- , junitConfigSourcePathPrefix :: Maybe FilePath- , junitConfigDropConsoleFormatting :: Bool+ { outputDirectory :: FilePath+ , outputName :: FilePath+ , outputFile :: Maybe FilePath+ , suiteName :: Text+ , sourcePathPrefix :: Maybe FilePath+ , dropConsoleFormatting :: Bool+ , pretty :: Bool } -- | Construct a 'JUnitConfig' given a suite name@@ -38,35 +41,35 @@ defaultJUnitConfig :: Text -> JUnitConfig defaultJUnitConfig name = JUnitConfig- { junitConfigOutputDirectory = "."- , junitConfigOutputName = "junit.xml"- , junitConfigOutputFile = Nothing- , junitConfigSuiteName = name- , junitConfigSourcePathPrefix = Nothing- , junitConfigDropConsoleFormatting = False+ { outputDirectory = "."+ , outputName = "junit.xml"+ , outputFile = Nothing+ , suiteName = name+ , sourcePathPrefix = Nothing+ , dropConsoleFormatting = False+ , pretty = False } -- | Set the directory within which to generate the report -- -- Default is current working directory. setJUnitConfigOutputDirectory :: FilePath -> JUnitConfig -> JUnitConfig-setJUnitConfigOutputDirectory x config =- config {junitConfigOutputDirectory = x}+setJUnitConfigOutputDirectory x config = config {outputDirectory = x} -- | Set the name for the generated report -- -- Default is @junit.xml@. setJUnitConfigOutputName :: FilePath -> JUnitConfig -> JUnitConfig-setJUnitConfigOutputName x config = config {junitConfigOutputName = x}+setJUnitConfigOutputName x config = config {outputName = x} -- | Set the full path to the generated report -- -- If given, the directory and name configurations are ignored. setJUnitConfigOutputFile :: FilePath -> JUnitConfig -> JUnitConfig-setJUnitConfigOutputFile x config = config {junitConfigOutputFile = Just x}+setJUnitConfigOutputFile x config = config {outputFile = Just x} setJUnitConfigSuiteName :: Text -> JUnitConfig -> JUnitConfig-setJUnitConfigSuiteName x config = config {junitConfigSuiteName = x}+setJUnitConfigSuiteName x config = config {suiteName = x} -- | Set a prefix to apply to source paths in the report --@@ -74,8 +77,7 @@ -- in a monorepository, and you need reported paths to be from the repository -- root. setJUnitConfigSourcePathPrefix :: FilePath -> JUnitConfig -> JUnitConfig-setJUnitConfigSourcePathPrefix x config =- config {junitConfigSourcePathPrefix = Just x}+setJUnitConfigSourcePathPrefix x config = config {sourcePathPrefix = Just x} -- | Set whether console formatting characters should be dropped from failure -- reports.@@ -83,27 +85,36 @@ -- Default is False. Most XML processors will fail to parse the XML if it -- contains the ANSI control characters used by console formatting. setJUnitConfigDropConsoleFormatting :: Bool -> JUnitConfig -> JUnitConfig-setJUnitConfigDropConsoleFormatting x config = config {junitConfigDropConsoleFormatting = x}+setJUnitConfigDropConsoleFormatting x config = config {dropConsoleFormatting = x} +-- | Set whether the file should be pretty-printed+--+-- @xml-conduit@ can pretty-print the contents of the XML file in order to make+-- it more human-readable. Note that this operation normalizes whitespace even+-- within nodes. This may turn multi-line failure messages into one line, for+-- example.+setJUnitConfigPretty :: Bool -> JUnitConfig -> JUnitConfig+setJUnitConfigPretty x config = config {pretty = x}+ -- | Retrieve the full path to the generated report getJUnitConfigOutputFile :: JUnitConfig -> FilePath-getJUnitConfigOutputFile JUnitConfig {..} =- fromMaybe- (junitConfigOutputDirectory </> junitConfigOutputName)- junitConfigOutputFile+getJUnitConfigOutputFile c = fromMaybe (c.outputDirectory </> c.outputName) c.outputFile -- | Retrieve the suite name given on construction getJUnitConfigSuiteName :: JUnitConfig -> Text-getJUnitConfigSuiteName = junitConfigSuiteName+getJUnitConfigSuiteName c = c.suiteName -- | Retrieve the function to apply to reported source paths -- -- Will be 'id' if no prefix configured. getJUnitPrefixSourcePath :: JUnitConfig -> FilePath -> FilePath-getJUnitPrefixSourcePath JUnitConfig {..} =- maybe id (</>) junitConfigSourcePathPrefix+getJUnitPrefixSourcePath c = maybe id (</>) c.sourcePathPrefix -- | Retrieve whether console formatting characters should be dropped from -- failure reports. getJUnitConfigDropConsoleFormatting :: JUnitConfig -> Bool-getJUnitConfigDropConsoleFormatting JUnitConfig {..} = junitConfigDropConsoleFormatting+getJUnitConfigDropConsoleFormatting c = c.dropConsoleFormatting++-- | Retrieve whether the file should be pretty-printed+getJUnitConfigPretty :: JUnitConfig -> Bool+getJUnitConfigPretty c = c.pretty
library/Test/Hspec/JUnit/Config/Env.hs view
@@ -11,7 +11,7 @@ import Data.Semigroup (Endo (..)) import Data.Text (pack, unpack)-import qualified Data.Text as T+import Data.Text qualified as T import System.Directory (getCurrentDirectory) import System.Environment (getEnvironment, lookupEnv) import System.FilePath (takeBaseName)@@ -42,16 +42,17 @@ readJUnitConfig base env = modify $ defaultJUnitConfig $ pack base where modify =- appEndo $- foldMap+ appEndo+ $ foldMap Endo [ readEnv "OUTPUT_DIRECTORY" setJUnitConfigOutputDirectory , readEnv "OUTPUT_NAME" setJUnitConfigOutputName , readEnv "OUTPUT_FILE" setJUnitConfigOutputFile , readEnv "SUITE_NAME" $ setJUnitConfigSuiteName . pack , readEnv "SOURCE_PATH_PREFIX" setJUnitConfigSourcePathPrefix- , readEnv "DROP_CONSOLE_FORMATTING" $- setJUnitConfigDropConsoleFormatting . (== "1")+ , readEnv "DROP_CONSOLE_FORMATTING"+ $ setJUnitConfigDropConsoleFormatting . (== "1")+ , readEnv "PRETTY" $ setJUnitConfigPretty . (== "1") ] readEnv name setter =
library/Test/Hspec/JUnit/Format.hs view
@@ -1,26 +1,42 @@+{-# OPTIONS_GHC -Wno-ambiguous-fields #-}+ module Test.Hspec.JUnit.Format ( junit ) where import Prelude +import Conduit import Control.Applicative ((<|>))-import Data.Conduit (runConduitRes, (.|))-import Data.Conduit.Combinators (sinkFile)-import Data.Conduit.List (sourceList)-import Data.Functor ((<&>))-import qualified Data.Map.Strict as Map-import Data.Maybe (fromMaybe)-import Data.Text (Text, pack, unpack)-import qualified Data.Text as T-import Data.Time (getCurrentTime)+import Control.Exception (displayException)+import Control.Monad.Reader (runReaderT)+import Data.List (intercalate)+import Data.List.NonEmpty (NonEmpty)+import Data.List.NonEmpty qualified as NE+import Data.Monoid (First (..))+import Data.Semigroup (Sum (..))+import Data.Semigroup.Generic (GenericSemigroupMonoid (..))+import Data.Text (Text, pack)+import Data.Time (UTCTime, getCurrentTime)+import Data.Typeable (typeOf)+import GHC.Generics (Generic)+import Numeric.Natural (Natural) import System.Directory (createDirectoryIfMissing)-import System.FilePath (splitFileName)+import System.FilePath (takeDirectory) import Test.Hspec.Api.Format.V1+ ( Event (..)+ , Format+ , FormatConfig+ , Item (..)+ , Location (..)+ , Path+ )+import Test.Hspec.Api.Format.V1 qualified as Hspec import Test.Hspec.JUnit.Config as Config-import Test.Hspec.JUnit.Render (renderJUnit)-import qualified Test.Hspec.JUnit.Schema as Schema+import Test.Hspec.JUnit.Render+import Test.Hspec.JUnit.Schema import Text.XML.Stream.Render (def, renderBytes)+import Text.XML.Stream.Render.Internal (rsPretty) junit :: JUnitConfig -> FormatConfig -> IO Format junit junitConfig _config = pure $ \case@@ -30,123 +46,169 @@ Progress _ _ -> pure () ItemStarted _ -> pure () ItemDone _ _ -> pure ()- Done paths -> do- time <- getCurrentTime-- let (directory, _) = splitFileName file- createDirectoryIfMissing True directory-- let- groups = groupItems paths- output =- Schema.Suites- { suitesName = suiteName- , suitesSuites =- groups <&> \(group, items) -> do- let suite xs =- Schema.Suite- { suiteName = group- , suiteTimestamp = time- , suiteCases = xs- }- suite $ uncurry (itemToTestCase applyPrefix group) <$> items- }-- runConduitRes $- sourceList [output]- .| renderJUnit dropConsoleFormatting- .| renderBytes def+ Done items -> do+ now <- getCurrentTime+ createDirectoryIfMissing True $ takeDirectory file+ runConduitRes+ $ transPipe (`runReaderT` junitConfig)+ $ renderTestsuites (formatTestsuites now suiteName items)+ .| renderBytes renderConfig .| sinkFile file where file = getJUnitConfigOutputFile junitConfig suiteName = getJUnitConfigSuiteName junitConfig- applyPrefix = getJUnitPrefixSourcePath junitConfig- dropConsoleFormatting = getJUnitConfigDropConsoleFormatting junitConfig+ renderConfig = def {rsPretty = getJUnitConfigPretty junitConfig} -groupItems :: [(Path, Item)] -> [(Text, [(Text, Item)])]-groupItems = Map.toList . Map.fromListWith (<>) . fmap group+formatTestsuites :: UTCTime -> Text -> [(Path, Item)] -> Testsuites+formatTestsuites now suiteName items =+ Testsuites+ { name = Attr suiteName+ , tests = getSum totals.tests+ , failures = getSum totals.failures+ , errors = getSum totals.errors+ , skipped = getSum totals.skipped+ , assertions = getSum totals.assertions+ , time = getSum totals.time+ , timestamp = Attr now+ , children = suites+ } where- group ((path, name), item) =- (T.intercalate "/" $ pack <$> path, [(pack name, item)])+ -- Group all items by prefix and then convert each group to a suite. In an+ -- ideal world, we would build a tree instead so we could correctly render+ -- nested contexts as nested testsuites, but that is hard and I'm tired.+ suites :: [Testsuite]+ suites = map (formatTestsuite now) $ NE.groupAllWith (fst . fst) items -itemToTestCase- :: (FilePath -> FilePath) -> Text -> Text -> Item -> Schema.TestCase-itemToTestCase applyPrefix group name item =- Schema.TestCase- { testCaseLocation =- toSchemaLocation applyPrefix- <$> (itemResultLocation item <|> itemLocation item)- , testCaseClassName = group- , testCaseName = name- , testCaseDuration = unSeconds $ itemDuration item- , testCaseResult = case itemResult item of- Success -> Nothing- Pending mLocation mMessage ->- Just $- Schema.Skipped $- prefixLocation mLocation $- prefixInfo $- maybe- ""- pack- mMessage- Failure mLocation reason ->- Just $- Schema.Failure "error" $- prefixLocation mLocation $- prefixInfo $- reasonToText reason+ totals :: SuiteTotals+ totals = foldMap getSuiteTotals suites++formatTestsuite :: UTCTime -> NonEmpty (Path, Item) -> Testsuite+formatTestsuite now items =+ Testsuite+ { name = Attr $ pack $ intercalate "/" path+ , tests = getSum totals.tests+ , failures = getSum totals.failures+ , errors = getSum totals.errors+ , skipped = getSum totals.skipped+ , assertions = getSum totals.assertions+ , time = getSum totals.time+ , timestamp = Attr now+ , file = getFirst totals.file+ , children } where- prefixLocation mLocation str = case mLocation of- Nothing -> str- Just Location {..} ->- mconcat- [ pack $ applyPrefix locationFile- , ":"- , pack $ show locationLine- , ":"- , pack $ show locationColumn- , "\n"- ]- <> str- prefixInfo str- | T.null $ T.strip $ pack $ itemInfo item = str- | otherwise = pack (itemInfo item) <> "\n\n" <> str+ path :: [String]+ path = fst $ fst $ NE.head items -itemResultLocation :: Item -> Maybe Location-itemResultLocation item = case itemResult item of- Success -> Nothing- Pending mLocation _ -> mLocation- Failure mLocation _ -> mLocation+ children :: [TestsuiteChild]+ children = NE.toList $ TestsuiteTestcase . formatTestcase <$> items -toSchemaLocation :: (FilePath -> FilePath) -> Location -> Schema.Location-toSchemaLocation applyPrefix Location {..} =- Schema.Location- { Schema.locationFile = applyPrefix locationFile- , Schema.locationLine = fromIntegral $ max 0 locationLine+ totals :: SuiteTotals+ totals = foldMap getSuiteChildTotals children++formatTestcase :: (Path, Item) -> Testcase+formatTestcase ((path, name), item) =+ Testcase+ { name = Attr $ pack name+ , classname = Attr $ pack $ intercalate "/" path+ , assertions = Attr 0 -- not available with Hspec+ , time = Attr $ itemDuration item+ , file = Attr . locationFile <$> location+ , line = Attr . fromIntegral . locationLine <$> location+ , properties = Nothing+ , systemStream = []+ , child }+ where+ (location, child) = case itemResult item of+ Hspec.Success ->+ ( itemLocation item+ , TestcaseEmpty+ )+ Hspec.Pending mLocation mMessage ->+ ( mLocation <|> itemLocation item+ , TestcaseSkipped $ Skipped $ maybe "" (Attr . pack) mMessage+ )+ Hspec.Failure mLocation reason ->+ ( mLocation <|> itemLocation item+ , formatFailureReason reason+ ) -unSeconds :: Seconds -> Double-unSeconds (Seconds x) = x+formatFailureReason :: Hspec.FailureReason -> TestcaseChild+formatFailureReason = \case+ Hspec.NoReason ->+ TestcaseFailure+ $ Failure+ { message = "No reason given"+ , type_ = "Failure.NoReason"+ , content = "No reason given"+ }+ Hspec.Reason msg ->+ TestcaseFailure+ $ Failure+ { message = Attr $ firstLineOf msg+ , type_ = "Failure.Reason"+ , content = Content $ pack $ msg <> "\n"+ }+ Hspec.ExpectedButGot mPrefix expected got ->+ TestcaseFailure+ $ Failure+ { message = Attr "Received value did not match expected"+ , type_ = Attr "Failure.ExpectedButGot"+ , content =+ Content+ $ pack+ $ mconcat+ [ maybe "" (<> "\n") mPrefix+ , "Expected: " <> show expected <> "\n"+ , " but got: " <> show got <> "\n"+ ]+ }+ Hspec.Error mPrefix ex ->+ TestcaseError+ $ Error+ { message = Attr $ firstLineOf $ displayException ex+ , type_ = Attr $ pack $ show $ typeOf ex+ , content =+ Content+ $ pack+ $ mconcat+ [ maybe "" (<> "\n") mPrefix+ , displayException ex <> "\n"+ ]+ }+ where+ firstLineOf =+ maybe "" (pack . NE.head)+ . NE.nonEmpty+ . lines -reasonToText :: FailureReason -> Text-reasonToText = \case- Error _ err -> pack $ show err- NoReason -> "no reason"- Reason err -> pack err- ExpectedButGot preface expected actual ->- T.unlines $- pack- <$> fromMaybe "" preface- : ( foundLines "expected" expected- <> foundLines " but got" actual- )+data SuiteTotals = SuiteTotals+ { tests :: Sum (Attr Natural)+ , failures :: Sum (Attr Natural)+ , errors :: Sum (Attr Natural)+ , skipped :: Sum (Attr Natural)+ , assertions :: Sum (Attr Natural)+ , time :: Sum (Attr Seconds)+ , file :: First (Attr FilePath)+ }+ deriving stock (Generic)+ deriving (Monoid, Semigroup) via GenericSemigroupMonoid SuiteTotals -foundLines :: Show a => Text -> a -> [String]-foundLines msg found = case lines' of- [] -> []- first : rest ->- unpack (msg <> ": " <> first) : (unpack . (T.replicate 9 " " <>) <$> rest)- where- lines' = T.lines . pack $ show found+getSuiteTotals :: Testsuite -> SuiteTotals+getSuiteTotals s = foldMap getSuiteChildTotals s.children++getSuiteChildTotals :: TestsuiteChild -> SuiteTotals+getSuiteChildTotals = \case+ TestsuiteTestcase tc ->+ let+ base :: SuiteTotals+ base = mempty {tests = 1, time = Sum tc.time, file = First tc.file}+ in+ case tc.child of+ TestcaseEmpty -> base+ TestcaseSkipped {} -> base {skipped = 1}+ TestcaseFailure {} -> base {failures = 1}+ TestcaseError {} -> base {errors = 1}+ TestsuiteTestsuite s -> getSuiteTotals s+ _ -> mempty
library/Test/Hspec/JUnit/Formatter.hs view
@@ -8,7 +8,7 @@ -- import Test.Hspec.JUnit.Config -- import Test.Hspec.JUnit.Formatter qualified as Formatter ----- -- | To only produce a JUnit file, silencing other output+-- -- | To produce only a JUnit file, silencing other output -- hook :: Spec -> Spec -- hook = Formatter.use defaultJUnitConfig --@@ -16,7 +16,7 @@ -- hook :: Spec -> Spec -- hook = Formatter.add defaultJUnitConfig ----- -- | To only produce, but only when @--format=junit@ is used+-- -- | To produce only a JUnit file, and only when @--format=junit@ is used -- hook :: Spec -> Spec -- hook = Formatter.register defaultJUnitConfig -- @@@ -40,10 +40,9 @@ import Prelude import Data.Maybe (fromMaybe)- import Test.Hspec.Api.Format.V1 as Api-import qualified Test.Hspec.Core.Format as Core-import qualified Test.Hspec.Core.Formatters.V2 as V2+import Test.Hspec.Core.Format qualified as Core+import Test.Hspec.Core.Formatters.V2 qualified as V2 import Test.Hspec.Core.Runner as Core (Config (..)) import Test.Hspec.JUnit.Config import Test.Hspec.JUnit.Format
library/Test/Hspec/JUnit/Formatter/Env.hs view
@@ -30,7 +30,7 @@ import Test.Hspec.Core.Spec (runIO) import Test.Hspec.JUnit.Config import Test.Hspec.JUnit.Config.Env-import qualified Test.Hspec.JUnit.Formatter as JUnit+import Test.Hspec.JUnit.Formatter qualified as JUnit whenEnabled :: (SpecWith a -> SpecWith a) -> SpecWith a -> SpecWith a whenEnabled hook spec = do
library/Test/Hspec/JUnit/Render.hs view
@@ -1,112 +1,215 @@ module Test.Hspec.JUnit.Render- ( renderJUnit+ ( renderTestsuites ) where import Prelude -import Control.Monad.Catch (MonadThrow)-import qualified Data.Array as Array-import Data.Conduit (ConduitT, awaitForever, mergeSource, yield, (.|))-import qualified Data.Conduit.List as CL+import Conduit (ConduitT)+import Control.Monad (unless)+import Control.Monad.Reader (MonadReader (..), asks)+import Data.Array qualified as Array+import Data.Fixed (Nano) import Data.Foldable (traverse_)+import Data.Semigroup (Endo (..)) import Data.Text (Text, pack)-import qualified Data.Text as Text+import Data.Text qualified as T import Data.Time.ISO8601 (formatISO8601) import Data.XML.Types (Event)+import Test.Hspec.JUnit.Config import Test.Hspec.JUnit.Schema- ( Location (..)- , Result (..)- , Suite (..)- , Suites (..)- , TestCase (..)- )-import Text.Printf-import qualified Text.Regex.Base as Regex-import qualified Text.Regex.TDFA.Text as Regex-import Text.XML.Stream.Render (attr, content, tag)+import Text.Regex.Base qualified as Regex+import Text.Regex.TDFA.Text (Regex)+import Text.XML.Stream.Render (attr, content, optionalAttr, tag) -renderJUnit :: MonadThrow m => Bool -> ConduitT Suites Event m ()-renderJUnit shouldDropConsoleFormatting = awaitForever $ \Suites {..} ->- tag "testsuites" (attr "name" suitesName) $- CL.sourceList suitesSuites- .| mergeSource idStream- .| suite shouldDropConsoleFormatting- where- idStream = CL.iterate (+ 1) 0+renderTestsuites+ :: MonadReader JUnitConfig m+ => Testsuites+ -> ConduitT i Event m ()+renderTestsuites s = do+ tag+ "testsuites"+ ( attr "name" (unAttr id s.name)+ <> attr "tests" (unAttr (pack . show) s.tests)+ <> attr "failures" (unAttr (pack . show) s.failures)+ <> attr "errors" (unAttr (pack . show) s.errors)+ <> attr "skipped" (unAttr (pack . show) s.skipped)+ <> attr "assertions" (unAttr (pack . show) s.assertions)+ <> attr "time" (unAttr unSeconds s.time)+ <> attr "timestamp" (unAttr (pack . formatISO8601) s.timestamp)+ )+ $ traverse_ renderTestsuite s.children -suite :: MonadThrow m => Bool -> ConduitT (Int, Suite) Event m ()-suite shouldDropConsoleFormatting = awaitForever $ \(i, theSuite@Suite {..}) ->- tag "testsuite" (attributes i theSuite) $ do- tag "properties" mempty mempty- CL.sourceList suiteCases .| do- awaitForever $ \x -> yield x .| testCase shouldDropConsoleFormatting- where- -- TODO these need to be made real values- attributes i Suite {..} =- attr "name" suiteName- <> attr "package" suiteName- <> attr "id" (tshow i)- <> attr "time" (roundToStr $ sumDurations suiteCases)- <> attr "timestamp" (pack $ formatISO8601 suiteTimestamp)- <> attr "hostname" "localhost"- <> attr "tests" (tshow $ length suiteCases)- <> attr- "failures"- ( tshow $- length [() | Just Failure {} <- testCaseResult <$> suiteCases]- )- <> attr "errors" "0"- <> attr- "skipped"- ( tshow $- length [() | Just Skipped {} <- testCaseResult <$> suiteCases]- )+renderTestsuite+ :: MonadReader JUnitConfig m+ => Testsuite+ -> ConduitT i Event m ()+renderTestsuite s = do+ prefix <- asks getJUnitPrefixSourcePath -tshow :: Show a => a -> Text-tshow = pack . show+ tag+ "testsuite"+ ( attr "name" (unAttr id s.name)+ <> attr "tests" (unAttr (pack . show) s.tests)+ <> attr "failures" (unAttr (pack . show) s.failures)+ <> attr "errors" (unAttr (pack . show) s.errors)+ <> attr "skipped" (unAttr (pack . show) s.skipped)+ <> attr "assertions" (unAttr (pack . show) s.assertions)+ <> attr "time" (unAttr unSeconds s.time)+ <> attr "timestamp" (unAttr (pack . formatISO8601) s.timestamp)+ <> optionalAttr "file" (unAttr (pack . prefix) <$> s.file)+ )+ $ traverse_ renderTestsuiteChild s.children -testCase :: MonadThrow m => Bool -> ConduitT TestCase Event m ()-testCase shouldDropConsoleFormatting =- awaitForever $ \(TestCase mLocation className name duration mResult) ->- tag "testcase" (attributes mLocation className name duration) $- traverse_ yield mResult- .| result shouldDropConsoleFormatting- where- attributes mLocation className name duration =- maybe mempty (attr "file" . pack . locationFile) mLocation- <> maybe mempty (attr "line" . pack . show . locationLine) mLocation- <> attr "name" name- <> attr "classname" className- <> attr "time" (roundToStr duration)+renderTestsuiteChild+ :: MonadReader JUnitConfig m+ => TestsuiteChild+ -> ConduitT i Event m ()+renderTestsuiteChild = \case+ TestsuiteProperties x -> renderProperties x+ TestsuiteSystemOut x -> renderSystemOut x+ TestsuiteSystemErr x -> renderSystemErr x+ TestsuiteTestcase x -> renderTestcase x+ TestsuiteTestsuite x -> renderTestsuite x -result :: MonadThrow m => Bool -> ConduitT Result Event m ()-result shouldDropConsoleFormatting = awaitForever go- where- go (Failure fType contents) =- tag "failure" (attr "type" fType) $ content $ dropConsoleFormatting contents- go (Skipped contents) = tag "skipped" mempty $ content $ dropConsoleFormatting contents+renderProperties+ :: MonadReader JUnitConfig m+ => Properties+ -> ConduitT i Event m ()+renderProperties ps = unless (null ps.unwrap) $ do+ tag "properties" mempty $ traverse_ renderProperty $ ps.unwrap - -- Drops ANSI control characters which might be used to set colors.- -- Including these breaks XML, there is not much point encoding them.- dropConsoleFormatting :: Text -> Text- dropConsoleFormatting input- | shouldDropConsoleFormatting =- let- regex = Regex.makeRegex (pack "\x1b\\[[0-9;]*[mGKHF]") :: Regex.Regex- matches = Regex.matchAll regex input- dropMatch (offset, len) input' =- let- (begining, rest) = Text.splitAt offset input'- (_, end) = Text.splitAt len rest- in- begining <> end- matchTuples = map (Array.! 0) matches- in- foldr dropMatch input matchTuples- | otherwise = input+renderProperty+ :: MonadReader JUnitConfig m+ => Property+ -> ConduitT i Event m ()+renderProperty p = case p.value of+ Left a ->+ tag "property" (attr "name" (unAttr id p.name) <> attr "value" (unAttr id a))+ $ pure ()+ Right c -> tag "property" (attr "name" (unAttr id p.name)) $ renderContent c -sumDurations :: [TestCase] -> Double-sumDurations cases = sum $ testCaseDuration <$> cases+renderSystemOut+ :: MonadReader JUnitConfig m+ => SystemOut+ -> ConduitT i Event m ()+renderSystemOut = tag "system-out" mempty . renderContent . (.unwrap) -roundToStr :: PrintfArg a => a -> Text-roundToStr = pack . printf "%0.9f"+renderSystemErr+ :: MonadReader JUnitConfig m+ => SystemErr+ -> ConduitT i Event m ()+renderSystemErr = tag "system-err" mempty . renderContent . (.unwrap)++renderTestcase+ :: MonadReader JUnitConfig m+ => Testcase+ -> ConduitT i Event m ()+renderTestcase c = do+ prefix <- asks getJUnitPrefixSourcePath++ tag+ "testcase"+ ( attr "name" (unAttr id c.name)+ <> attr "classname" (unAttr id c.classname)+ <> attr "assertions" (unAttr (pack . show) c.assertions)+ <> attr "time" (unAttr unSeconds c.time)+ <> optionalAttr "file" (unAttr (pack . prefix) <$> c.file)+ <> optionalAttr "line" (unAttr (pack . show) <$> c.line)+ )+ $ do+ traverse_ renderProperties c.properties+ traverse_ (either renderSystemOut renderSystemErr) c.systemStream+ renderTestcaseChild c.child++renderTestcaseChild+ :: MonadReader JUnitConfig m+ => TestcaseChild+ -> ConduitT i Event m ()+renderTestcaseChild = \case+ TestcaseEmpty -> pure ()+ TestcaseSkipped x -> renderSkipped x+ TestcaseFailure x -> renderFailure x+ TestcaseError x -> renderError x++renderSkipped+ :: MonadReader JUnitConfig m+ => Skipped+ -> ConduitT i Event m ()+renderSkipped s = tag "skipped" (attr "message" (unAttr id s.message)) $ pure ()++renderFailure+ :: MonadReader JUnitConfig m+ => Failure+ -> ConduitT i Event m ()+renderFailure f =+ tag+ "failure"+ (attr "message" (unAttr id f.message) <> attr "type" (unAttr id f.type_))+ $ renderContent f.content++renderError+ :: MonadReader JUnitConfig m+ => Error+ -> ConduitT i Event m ()+renderError e =+ tag+ "error"+ (attr "message" (unAttr id e.message) <> attr "type" (unAttr id e.type_))+ $ renderContent e.content++renderContent+ :: MonadReader JUnitConfig m+ => Content+ -> ConduitT i Event m ()+renderContent c = do+ shouldDropConsoleFormatting <- asks getJUnitConfigDropConsoleFormatting++ let clean =+ if shouldDropConsoleFormatting+ then dropConsoleFormatting+ else id++ content $ clean $ c.unwrap++unSeconds :: Seconds -> Text+unSeconds (Seconds d) = pack $ show $ realToFrac @_ @Nano d++-- | Safely render an attribute+--+-- HTML encoding is handled by @xml-conduit@, but additionally we:+--+-- * Drop console formatting (always)+-- * Extra-escape unsupported characters (e.g @\a@ becomes @\\a@)+unAttr :: (a -> Text) -> Attr a -> Text+unAttr f = escapeIllegal . dropConsoleFormatting . f . (.unwrap)++escapeIllegal :: Text -> Text+escapeIllegal =+ appEndo+ $ foldMap+ (\(a, b) -> Endo $ T.replace a b)+ [ ("\0", "\\0")+ , ("\a", "\\a")+ , ("\b", "\\b")+ , ("\f", "\\f")+ , ("\v", "\\v")+ , ("\ESC", "\\ESC")+ ]++-- | Drop ANSI control characters which might be used to set colors+--+-- We always do this in attribute values, since they'd only break XML, but we+-- only do it in content if configured by options, since we want any content+-- node changes to be opt-in.+dropConsoleFormatting :: Text -> Text+dropConsoleFormatting input =+ foldr (dropBetween . (Array.! 0)) input $ Regex.matchAll escRegex input++escRegex :: Regex+escRegex = Regex.makeRegex ("\x1b\\[[0-9;]*[mGKHF]" :: Text)++dropBetween :: (Int, Int) -> Text -> Text+dropBetween (offset, len) input = begining <> end+ where+ (begining, rest) = T.splitAt offset input+ (_, end) = T.splitAt len rest
library/Test/Hspec/JUnit/Schema.hs view
@@ -1,44 +1,201 @@+-- | The structure of a JUnit XML file+--+-- This intends to be a complete and accurate representation of+-- <https://github.com/testmoapp/junitxml#complete-junit-xml-example>, though we+-- don't (and sometimes can't) exercise all of it. module Test.Hspec.JUnit.Schema- ( Suites (..)- , Suite (..)- , TestCase (..)- , Location (..)- , Result (..)+ ( Testsuites (..)+ , Testsuite (..)+ , TestsuiteChild (..)+ , Testcase (..)+ , TestcaseChild (..)+ , Skipped (..)+ , Failure (..)+ , Error (..)+ , Properties (..)+ , Property (..)+ , SystemOut (..)+ , SystemErr (..)++ -- * Tagged XML types+ , Attr (..)+ , Content (..)++ -- * Other wrapper types+ , Seconds (..) ) where import Prelude +import Data.String (IsString) import Data.Text (Text) import Data.Time (UTCTime)-import Numeric.Natural+import Numeric.Natural (Natural)+import Test.Hspec.Core.Format (Seconds (..)) -data Suites = Suites- { suitesName :: Text- , suitesSuites :: [Suite]+-- | @<testsuites>@+--+-- Usually the root element of a JUnit XML file. Some tools leave out the+-- @<testsuites>@ element if there is only a single top-level @<testsuite>@+-- element (which is then used as the root element).+data Testsuites = Testsuites+ { name :: Attr Text+ -- ^ Name of the entire test run+ , tests :: Attr Natural+ -- ^ Total number of tests in this file+ , failures :: Attr Natural+ -- ^ Total number of failed tests in this file+ , errors :: Attr Natural+ -- ^ Total number of errored tests in this file+ , skipped :: Attr Natural+ -- ^ Total number of skipped tests in this file+ , assertions :: Attr Natural+ -- ^ Total number of assertions for all tests in this file+ , time :: Attr Seconds+ -- ^ Aggregated time of all tests in this file in seconds+ , timestamp :: Attr UTCTime+ -- ^ Date and time of when the test run was executed (in ISO 8601 format)+ , children :: [Testsuite]+ -- ^ Only @<testsuite>@s can be descendents of this node }- deriving stock (Show) -data Suite = Suite- { suiteName :: Text- , suiteTimestamp :: UTCTime- , suiteCases :: [TestCase]+-- | @<testsuite>@+--+-- A test suite usually represents a class, folder or group of tests. There can+-- be many test suites in an XML file, and there can be test suites under other+-- test suites.+data Testsuite = Testsuite+ { name :: Attr Text+ -- ^ Name of the test suite (e.g. class name or folder name)+ , tests :: Attr Natural+ -- ^ Total number of tests in this suite+ , failures :: Attr Natural+ -- ^ Total number of failed tests in this suite+ , errors :: Attr Natural+ -- ^ Total number of errored tests in this suite+ , skipped :: Attr Natural+ -- ^ Total number of skipped tests in this suite+ , assertions :: Attr Natural+ -- ^ Total number of assertions for all tests in this suite+ , time :: Attr Seconds+ -- ^ Aggregated time of all tests in this file in seconds+ , timestamp :: Attr UTCTime+ -- ^ Date and time of when the test suite was executed (in ISO 8601 format)+ , file :: Maybe (Attr FilePath)+ -- ^ Source code file of this test suite+ , children :: [TestsuiteChild] }- deriving stock (Show) -data TestCase = TestCase- { testCaseLocation :: Maybe Location- , testCaseClassName :: Text- , testCaseName :: Text- , testCaseDuration :: Double- , testCaseResult :: Maybe Result+-- | @<testsuite>@ can contain nodes that are any of these+data TestsuiteChild+ = TestsuiteProperties Properties+ | TestsuiteSystemOut SystemOut+ | TestsuiteSystemErr SystemErr+ | TestsuiteTestcase Testcase+ | TestsuiteTestsuite Testsuite++-- | @<properties>@+--+-- Test suites can have additional properties such as environment variables or+-- version numbers. Some tools also support properties for test cases.+newtype Properties = Properties+ { unwrap :: [Property] }- deriving stock (Show) -data Location = Location- { locationFile :: FilePath- , locationLine :: Natural+-- | @<property>@+--+-- Each property has a name and value. Some tools also support properties with+-- text values instead of value attributes.+data Property = Property+ { name :: Attr Text+ , value :: Either (Attr Text) Content }- deriving stock (Show) -data Result = Failure Text Text | Skipped Text- deriving stock (Show)+-- | @<system-out>@+--+-- Optionally data written to standard out for the suite. Also supported on a+-- test case level, see below.+newtype SystemOut = SystemOut+ { unwrap :: Content+ }++-- | @<system-err>@+--+-- Optionally data written to standard error for the suite. Also supported on a+-- test case level, see below.+newtype SystemErr = SystemErr+ { unwrap :: Content+ }++-- | @<testcase>@+--+-- There are one or more test cases in a test suite. A test passed if there+-- isn't an additional result element (skipped, failure, error).+data Testcase = Testcase+ { name :: Attr Text+ -- ^ The name of this test case, often the method name+ , classname :: Attr Text+ -- ^ The name of the parent class/folder, often the same as the suite's name+ , assertions :: Attr Natural+ -- ^ Number of assertions checked during test case execution+ , time :: Attr Seconds+ -- ^ Execution time of the test in seconds+ , file :: Maybe (Attr FilePath)+ -- ^ Source code file of this test case+ , line :: Maybe (Attr Natural)+ -- ^ Source code line number of the start of this test case+ , properties :: Maybe Properties+ , systemStream :: [Either SystemOut SystemErr]+ -- ^ Stored as a combined list to represent ordering and interleaving+ , child :: TestcaseChild+ }++-- | @<testcase>@ will contain only one of these+data TestcaseChild+ = -- | Success case+ TestcaseEmpty+ | TestcaseSkipped Skipped+ | TestcaseFailure Failure+ | TestcaseError Error++-- | @<skipped>@+--+-- Indicates that the test was not executed. Can have an optional message+-- describing why the test was skipped.+newtype Skipped = Skipped+ { message :: Attr Text+ }++-- | @<failure>@+--+-- The test failed because one of the assertions/checks failed. Can have a+-- message and failure type, often the assertion type or class. The text content+-- of the element often includes the failure description or stack trace.+data Failure = Failure+ { message :: Attr Text+ , type_ :: Attr Text+ , content :: Content+ -- ^ Failure description or stack trace+ }++-- | @<error>@+--+-- The test had an unexpected error during execution. Can have a message and+-- error type, often the exception type or class. The text content of the+-- element often includes the error description or stack trace.+data Error = Error+ { message :: Attr Text+ , type_ :: Attr Text+ , content :: Content+ -- ^ Error description or stack trace+ }++newtype Attr a = Attr+ { unwrap :: a+ }+ deriving newtype (IsString, Num)++newtype Content = Content+ { unwrap :: Text+ }+ deriving newtype (IsString)
tests/Example.hs view
@@ -5,9 +5,9 @@ -- In fact, this sentence was added to retain them across a formatting change. module Example (spec) where -import Control.Exception import Prelude +import Control.Exception import Test.Hspec spec :: Spec
tests/Test/Hspec/JUnit/FormatterSpec.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}+{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Test.Hspec.JUnit.FormatterSpec ( spec@@ -7,112 +7,331 @@ import Prelude import Control.Monad (void)-import Data.Char (isSpace)-import qualified Data.Map.Strict as Map-import qualified Data.Text as T-import qualified Example-import System.FilePath ((<.>), (</>))+import Data.Fixed (Micro, Nano)+import Data.Maybe (isJust)+import Data.Text (Text, unpack)+import Data.Text qualified as T+import Data.Time.ISO8601 (parseISO8601)+import Example qualified+import System.FilePath ((</>)) import System.IO.Temp (withSystemTempDirectory) import Test.Hspec-import Test.Hspec.Golden import Test.Hspec.JUnit.Config-import qualified Test.Hspec.JUnit.Formatter as Formatter-import Test.Hspec.Runner-import qualified Text.XML as XML+import Test.Hspec.JUnit.Formatter qualified as Formatter+import Test.Hspec.Runner qualified as Hspec+import Text.Read (readMaybe)+import Text.XML qualified as XML+import Text.XML.Cursor spec :: Spec spec = do- it "matches golden file" $- junitGolden "default" id+ context "ExampleSpec" $ do+ doc <- runIO $ fromDocument <$> renderJUnitXml testConfig Example.spec - it "matches golden file with prefixing" $- junitGolden "prefixed" $- setJUnitConfigSourcePathPrefix "lol/monorepo"+ context "time attributes" $ do+ it "sums correctly on testsuites and testsuite" $ do+ let+ -- Do the summation at Nano...+ readNano :: Text -> Nano+ readNano = maybe 0 realToFrac . readMaybe @Double . unpack --- | Run @Example.spec@ and compare XML to a golden file-junitGolden- :: String- -- ^ Unique name- -> (JUnitConfig -> JUnitConfig)- -- ^ Any modification to make to the 'JUnitConfig' before running- -> IO (Golden XML.Document)-junitGolden name modifyConfig = do- actual <- withSystemTempDirectory "" $ \tmp -> do- let junitConfig =- modifyConfig $- setJUnitConfigOutputDirectory tmp $- setJUnitConfigOutputName "test.xml" $- defaultJUnitConfig "hspec-junit-format"+ -- ...but truncate to Micro for comparison+ readTimes :: [[Text]] -> Micro+ readTimes = realToFrac . sum . concatMap (map readNano) - runSpec' $ Formatter.use junitConfig Example.spec- readNormalizedXML $ tmp </> "test.xml"+ suitesTime :: Micro+ suitesTime =+ readTimes+ $ doc+ $| element "testsuites"+ &| attribute "time" - pure- Golden- { output = actual- , encodePretty = show- , writeToFile = XML.writeFile XML.def- , readFromFile = readNormalizedXML- , goldenFile =- "tests" </> "golden" </> name <> "-" <> ghcSuffix <.> "xml"- , actualFile = Nothing- , failFirstTime = False- }+ suiteTimes :: Micro+ suiteTimes =+ readTimes+ $ doc+ $| element "testsuites"+ &/ element "testsuite"+ &| attribute "time" -runSpec' :: Spec -> IO ()-runSpec' x = do- (config, forest) <- evalSpec defaultConfig x- void $ runSpecForest forest config+ casesTimes :: Micro+ casesTimes =+ readTimes+ $ doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "time" -readNormalizedXML :: FilePath -> IO XML.Document-readNormalizedXML = fmap normalizeDoc . XML.readFile XML.def+ suitesTime `shouldSatisfy` (> 0)+ suitesTime `shouldBe` suiteTimes+ suitesTime `shouldBe` casesTimes -normalizeDoc :: XML.Document -> XML.Document-normalizeDoc = removeWhitespaceNodes . removeTimeAttributes+ context "timestamp attributes" $ do+ it "has the same timestamp on testsuites and testsuite" $ do+ let+ [suitesTimestamp] =+ concatMap (map (parseISO8601 . unpack))+ $ doc+ $| element "testsuites"+ &| attribute "timestamp" -removeWhitespaceNodes :: XML.Document -> XML.Document-removeWhitespaceNodes doc =- doc- { XML.documentRoot = go $ XML.documentRoot doc- }- where- go el =- el {XML.elementNodes = concatMap filterWhitespace $ XML.elementNodes el}+ [suite1Timestamp, suite2Timestamp] =+ concatMap (map (parseISO8601 . unpack))+ $ doc+ $| element "testsuites"+ &/ element "testsuite"+ &| attribute "timestamp" - filterWhitespace :: XML.Node -> [XML.Node]- filterWhitespace = \case- XML.NodeElement el -> [XML.NodeElement $ go el]- XML.NodeContent c | T.all isSpace c -> []- n -> [n]+ suitesTimestamp `shouldSatisfy` isJust+ suite1Timestamp `shouldSatisfy` isJust+ suite2Timestamp `shouldSatisfy` isJust+ suite1Timestamp `shouldBe` suitesTimestamp+ suite2Timestamp `shouldBe` suitesTimestamp --- | Remove volatile attributes so they don't invalidate comparison-removeTimeAttributes :: XML.Document -> XML.Document-removeTimeAttributes =- removeAttributesByName "time" . removeAttributesByName "timestamp"+ context "testsuites node" $ do+ it "produces one, with our package name" $ do+ ( doc+ $| element "testsuites"+ &| attribute "name"+ )+ `shouldBe` [["hspec-junit-format"]] -removeAttributesByName :: XML.Name -> XML.Document -> XML.Document-removeAttributesByName name doc =- doc- { XML.documentRoot = go $ XML.documentRoot doc- }- where- go el =- el- { XML.elementAttributes = Map.delete name $ XML.elementAttributes el- , XML.elementNodes = map (onNodeElement go) $ XML.elementNodes el- }+ context "testsuite nodes" $ do+ it "produces two" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ )+ `shouldSatisfy` (== 2) . length - onNodeElement f = \case- XML.NodeElement el -> XML.NodeElement $ f el- n -> n+ it "has name" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &| attribute "name"+ )+ `shouldBe` [ ["Some section"]+ , ["Some section/A grouped context"]+ ] --- GHC can change certain aspects, mainly about source-location, so we can--- incorpate that by tracking separate Golden files as necessary-ghcSuffix :: String-#if __GLASGOW_HASKELL__ >= 900-ghcSuffix = "ghc-9"-#elif __GLASGOW_HASKELL__ >= 800-ghcSuffix = "ghc-8"-#else--- Fail to compile on other GHCs-#endif+ context "testcase nodes" $ do+ it "has time" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "time"+ )+ `shouldSatisfy` (== 6) . length++ it "has timestamp" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "timestamp"+ )+ `shouldSatisfy` (== 6) . length++ it "has classname" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "classname"+ )+ `shouldBe` ( replicate 2 ["Some section"]+ <> replicate 4 ["Some section/A grouped context"]+ )++ it "has file" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "file"+ )+ `shouldBe` replicate 6 ["tests/Example.hs"]++ it "has name" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "name"+ )+ `shouldBe` [ ["has an expectation"]+ , ["has a failure"]+ , ["happens in a group"]+ , ["also happens in a group"]+ , ["gets skipped"]+ , ["throws a colourful exception"]+ ]++ context "first testsuite" $ do+ let [testsuite, _] = doc $| element "testsuites" &/ element "testsuite"++ it "has correct counts" $ do+ (testsuite $| attribute "errors") `shouldBe` ["0"]+ (testsuite $| attribute "failures") `shouldBe` ["1"]+ (testsuite $| attribute "skipped") `shouldBe` ["0"]+ (testsuite $| attribute "tests") `shouldBe` ["2"]++ it "produces two testcase nodes" $ do+ (testsuite $/ element "testcase") `shouldSatisfy` (== 2) . length++ context "first testcase" $ do+ let [testcase, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["16"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["has an expectation"]++ it "has no child nodes" $ do+ (testcase $| child &| node) `shouldBe` []++ context "second testcase" $ do+ let [_, testcase] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["19"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["has a failure"]++ it "has a failure reported" $ do+ ( testcase+ $/ element "failure"+ &/ content+ )+ `shouldBe` [ T.unlines+ [ "Expected: \"False\""+ , " but got: \"True\""+ ]+ ]++ context "second testsuite" $ do+ let [_, testsuite] =+ doc+ $| element "testsuites"+ &/ element "testsuite"++ it "has correct counts" $ do+ (testsuite $| attribute "errors") `shouldBe` ["1"]+ (testsuite $| attribute "failures") `shouldBe` ["0"]+ (testsuite $| attribute "skipped") `shouldBe` ["1"]+ (testsuite $| attribute "tests") `shouldBe` ["4"]++ it "produces four testcase nodes" $ do+ (testsuite $/ element "testcase") `shouldSatisfy` (== 4) . length++ context "first testcase" $ do+ let [testcase, _, _, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["22"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["happens in a group"]++ it "has no child nodes" $ do+ (testcase $| child &| node) `shouldBe` []++ context "second testcase" $ do+ let [_, testcase, _, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["24"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["also happens in a group"]++ it "has no child nodes" $ do+ (testcase $| child &| node) `shouldBe` []++ context "third testcase" $ do+ let [_, _, testcase, _] = testsuite $/ element "testcase"++ it "has line" $ do+ (testcase $| attribute "line") `shouldBe` ["27"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["gets skipped"]++ it "has a skipped node" $ do+ ( testcase+ $/ element "skipped"+ &| attribute "message"+ )+ `shouldBe` [["some reason"]]++ context "fourth testcase" $ do+ let [_, _, _, testcase] = testsuite $/ element "testcase"++ it "has line" $ do+ pendingWith "Newer base returns line 29"+ (testcase $| attribute "line") `shouldBe` ["28"]++ it "has name" $ do+ (testcase $| attribute "name") `shouldBe` ["throws a colourful exception"]++ context "error content" $ do+ let [el] = testcase $/ element "error"++ it "strips escapes from a message attribute" $ do+ -- Annoying, but Hspec has tied our hands here+ (el $| attribute "type") `shouldBe` ["SomeException"]+ (el $| attribute "message") `shouldBe` ["ColourfulException"]++ it "does not strip escapes in content" $ do+ let [c] = el $/ content++ take 1 (T.lines c) `shouldBe` ["\ESC[32mColour\ESC[31mful\ESC[0mException"]++ context "ExampleSpec with prefixing" $ do+ let testConfig' = setJUnitConfigSourcePathPrefix "lol/monorepo" testConfig+ doc <- runIO $ fromDocument <$> renderJUnitXml testConfig' Example.spec++ it "prefixes testcase file attributes" $ do+ ( doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &| attribute "file"+ )+ `shouldBe` replicate 6 ["lol/monorepo/tests/Example.hs"]++ context "ExampleSpec with dropConsoleFormatting" $ do+ let testConfig' = setJUnitConfigDropConsoleFormatting True testConfig+ doc <- runIO $ fromDocument <$> renderJUnitXml testConfig' Example.spec++ it "drops console formatting in text nodes" $ do+ let [c] =+ doc+ $| element "testsuites"+ &/ element "testsuite"+ &/ element "testcase"+ &/ element "error"+ &/ content++ take 1 (T.lines c) `shouldBe` ["ColourfulException"]++testConfig :: JUnitConfig+testConfig = defaultJUnitConfig "hspec-junit-format"++renderJUnitXml :: JUnitConfig -> Spec -> IO XML.Document+renderJUnitXml baseConfig x = do+ withSystemTempDirectory "" $ \tmp -> do+ let junitConfig =+ setJUnitConfigOutputDirectory tmp+ $ setJUnitConfigOutputName "test.xml" baseConfig++ (config, forest) <-+ Hspec.evalSpec Hspec.defaultConfig $ Formatter.use junitConfig x++ void $ Hspec.runSpecForest forest config++ XML.readFile XML.def $ tmp </> "test.xml"
− tests/golden/default-ghc-8.xml
@@ -1,69 +0,0 @@-<testsuites name="hspec-junit-format">- <testsuite- name="Some section"- package="Some section"- id="0"- hostname="localhost"- time="0.000032355"- timestamp="2021-05-17T15:36:10.205608409Z"- tests="2" failures="1" errors="0" skipped="0">- <properties/>- <testcase- file="tests/Example.hs"- line="19"- name="has a failure"- classname="Some section"- time="0.000015537">- <failure type="error">tests/Example.hs:19:7--expected: "False"- but got: "True"-</failure>- </testcase>- <testcase- file="tests/Example.hs"- line="16"- name="has an expectation"- classname="Some section"- time="0.000016818"/>- </testsuite>- <testsuite- name="Some section/A grouped context"- package="Some section/A grouped context"- id="1"- time="0.000021009"- timestamp="2021-05-17T15:36:10.205608409Z"- hostname="localhost"- tests="4" failures="1" errors="0" skipped="1">- <properties/>- <testcase- file="tests/Example.hs"- line="28"- name="throws a colourful exception"- classname="Some section/A grouped context"- time="0.000012194">- <failure type="error">ColourfulException</failure>- </testcase>- <testcase- file="tests/Example.hs"- line="27"- name="gets skipped"- classname="Some section/A grouped context"- time="0.000006765">- <skipped>tests/Example.hs:27:9-some reason</skipped>- </testcase>- <testcase- file="tests/Example.hs"- line="24"- name="also happens in a group"- classname="Some section/A grouped context"- time="0.000007421"/>- <testcase- file="tests/Example.hs"- line="22"- name="happens in a group"- classname="Some section/A grouped context"- time="0.000006823"/>- </testsuite>-</testsuites>
− tests/golden/default-ghc-9.xml
@@ -1,6 +0,0 @@-<?xml version="1.0" encoding="UTF-8"?><testsuites name="hspec-junit-format"><testsuite errors="0" failures="1" hostname="localhost" id="0" name="Some section" package="Some section" skipped="0" tests="2"><properties/><testcase classname="Some section" file="tests/Example.hs" line="19" name="has a failure"><failure type="error">tests/Example.hs:19:12--expected: "False"- but got: "True"-</failure></testcase><testcase classname="Some section" file="tests/Example.hs" line="16" name="has an expectation"/></testsuite><testsuite errors="0" failures="1" hostname="localhost" id="1" name="Some section/A grouped context" package="Some section/A grouped context" skipped="1" tests="4"><properties/><testcase classname="Some section/A grouped context" file="tests/Example.hs" line="28" name="throws a colourful exception"><failure type="error">ColourfulException</failure></testcase><testcase classname="Some section/A grouped context" file="tests/Example.hs" line="27" name="gets skipped"><skipped>tests/Example.hs:27:9-some reason</skipped></testcase><testcase classname="Some section/A grouped context" file="tests/Example.hs" line="24" name="also happens in a group"/><testcase classname="Some section/A grouped context" file="tests/Example.hs" line="22" name="happens in a group"/></testsuite></testsuites>
− tests/golden/prefixed-ghc-8.xml
@@ -1,69 +0,0 @@-<testsuites name="hspec-junit-format">- <testsuite- name="Some section"- package="Some section"- id="0"- hostname="localhost"- time="0.000032355"- timestamp="2021-05-17T15:36:10.205608409Z"- tests="2" failures="1" errors="0" skipped="0">- <properties/>- <testcase- file="lol/monorepo/tests/Example.hs"- line="19"- name="has a failure"- classname="Some section"- time="0.000015537">- <failure type="error">lol/monorepo/tests/Example.hs:19:7--expected: "False"- but got: "True"-</failure>- </testcase>- <testcase- file="lol/monorepo/tests/Example.hs"- line="16"- name="has an expectation"- classname="Some section"- time="0.000016818"/>- </testsuite>- <testsuite- name="Some section/A grouped context"- package="Some section/A grouped context"- id="1"- time="0.000021009"- timestamp="2021-05-17T15:36:10.205608409Z"- hostname="localhost"- tests="4" failures="1" errors="0" skipped="1">- <properties/>- <testcase- file="lol/monorepo/tests/Example.hs"- line="28"- name="throws a colourful exception"- classname="Some section/A grouped context"- time="0.000012194">- <failure type="error">ColourfulException</failure>- </testcase>- <testcase- file="lol/monorepo/tests/Example.hs"- line="27"- name="gets skipped"- classname="Some section/A grouped context"- time="0.000006765">- <skipped>lol/monorepo/tests/Example.hs:27:9-some reason</skipped>- </testcase>- <testcase- file="lol/monorepo/tests/Example.hs"- line="24"- name="also happens in a group"- classname="Some section/A grouped context"- time="0.000007421"/>- <testcase- file="lol/monorepo/tests/Example.hs"- line="22"- name="happens in a group"- classname="Some section/A grouped context"- time="0.000006823"/>- </testsuite>-</testsuites>
− tests/golden/prefixed-ghc-9.xml
@@ -1,69 +0,0 @@-<testsuites name="hspec-junit-format">- <testsuite- name="Some section"- package="Some section"- id="0"- hostname="localhost"- time="0.000032355"- timestamp="2021-05-17T15:36:10.205608409Z"- tests="2" failures="1" errors="0" skipped="0">- <properties/>- <testcase- file="lol/monorepo/tests/Example.hs"- line="19"- name="has a failure"- classname="Some section"- time="0.000015537">- <failure type="error">lol/monorepo/tests/Example.hs:19:12--expected: "False"- but got: "True"-</failure>- </testcase>- <testcase- file="lol/monorepo/tests/Example.hs"- line="16"- name="has an expectation"- classname="Some section"- time="0.000016818"/>- </testsuite>- <testsuite- name="Some section/A grouped context"- package="Some section/A grouped context"- id="1"- time="0.000021009"- timestamp="2021-05-17T15:36:10.205608409Z"- hostname="localhost"- tests="4" failures="1" errors="0" skipped="1">- <properties/>- <testcase- file="lol/monorepo/tests/Example.hs"- line="28"- name="throws a colourful exception"- classname="Some section/A grouped context"- time="0.000012194">- <failure type="error">ColourfulException</failure>- </testcase>- <testcase- file="lol/monorepo/tests/Example.hs"- line="27"- name="gets skipped"- classname="Some section/A grouped context"- time="0.000006765">- <skipped>lol/monorepo/tests/Example.hs:27:9-some reason</skipped>- </testcase>- <testcase- file="lol/monorepo/tests/Example.hs"- line="24"- name="also happens in a group"- classname="Some section/A grouped context"- time="0.000007421"/>- <testcase- file="lol/monorepo/tests/Example.hs"- line="22"- name="happens in a group"- classname="Some section/A grouped context"- time="0.000006823"/>- </testsuite>-</testsuites>