packages feed

tasty-autocollect 0.4.1 → 0.4.2

raw patch · 32 files changed

+270/−670 lines, 32 filesdep ~basedep ~bytestringdep ~containers

Dependency ranges changed: base, bytestring, containers, directory, explainable-predicates, filepath, ghc, tasty, tasty-expected-failure, tasty-quickcheck, template-haskell, text, transformers, typed-process

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+# v0.4.2++* Add support for GHC 9.8+* Drop support for GHC 9.0 and 9.2+ # v0.4.1  * Add support for GHC 9.6@@ -8,6 +13,7 @@ * Added support for where clauses in `test_prop`, where the where clause may reference the generated arguments in `test_prop` * Don't autocollect invalid module names * Enable importing configuration from other files+* Add support for custom main files  # v0.3.2.0
README.md view
@@ -152,8 +152,7 @@ The last example will be converted into the equivalent of:  ```hs-tasty_test_4 :: TestTree-tasty_test_4 =+test =   ignoreTestBecause "Issue #123" $     testCase "this test is skipped" $ ... ```@@ -238,37 +237,36 @@  ## Comparison with other libraries -### `tasty-discover`- Advantages:-* Supports test functions with multiple arguments (e.g. `tasty-golden`)-* Avoids hardcoding testers like `unit_` or `prop_`+* Avoids hardcoding blessed test frameworks+  * Both `tasty-discover` and `tasty-th` prefix tests with hardcoded prefixes like `unit_` or `prop_`. While they both provide a mechanism to specify arbitrary `TestTree`s with `test_`, it makes for a less seamless integration with unblessed test frameworks, such as `tasty-golden`:+    ```hs+    test_do_something :: TestTree+    test_do_something =+      goldenVsString "do something" "goldens/do_something.golden" $ ...+    ```+  * With `tasty-autocollect`, all tests are specified the same way (modulo some syntax sugar niceties like `test_prop`) * Avoids rewriting test label twice in function name+  * Both `tasty-discover` and `tasty-th` force you to repeat long test names twice:+    ```hs+    unit_this_is_a_test :: Assertion+    unit_this_is_a_test = do+      ...+    ``` * Avoids test name restrictions-    * Because `tasty-discover` couples the function name with the test label, you can't do things like use punctuation in the test label. So `tasty-discover` doesn't allow writing the equivalent of `testProperty "reverse . reverse === id"`.+  * Because `tasty-discover` and `tasty-th` couple the function name with the test label, you can't do things like use punctuation in the test label. So these frameworks don't allow writing the equivalent of `testProperty "reverse . reverse === id"`. * More features out-of-the-box (see "Features" section) * More configurable-    * More configuration options-    * Configuration is more extensible, since configuration is parsed from a comment in the main module instead of as preprocessor arguments--Disadvantages:-* Uses both a preprocessor and a GHC plugin-    * `tasty-discover` only uses a preprocessor-    * Haven't tested performance yet, but I wouldn't be surprised if there's a non-negligible performance cost--### `tasty-th`--Advantages:-* See `tasty-discover`+  * More configuration options+  * Configuration is more extensible, since configuration is parsed from a comment in the main module instead of as preprocessor arguments (for `tasty-discover`)+  * `tasty-th` isn't configurable at all * Automatically generates the `Main.hs` file that discovers + imports all test modules in the directory-    * `tasty-th` provides `defaultMainGenerator`, but it only discovers tests in the same module, so if you have tests in multiple files, you'd still have to manually import all of them into a `Main.hs` file+  * `tasty-discover` does this, but `tasty-th` does not; `tasty-th` provides `defaultMainGenerator`, but it only discovers tests in the same module, so if you have tests in multiple files, you'd still have to manually import all of them into a `Main.hs` file  Disadvantages:-* Uses a preprocessor and a GHC plugin-    * `tasty-th` uses Template Haskell instead of either-    * Haven't tested performance yet, but I wouldn't be surprised if there's a non-negligible performance cost-* `tasty-th` allows including a subset of functions, but not others-    * `tasty-autocollect` includes all tests in one exported list+* Uses both a preprocessor and a GHC plugin+    * `tasty-discover` only uses a preprocessor, while `tasty-th` uses Template Haskell+    * Haven't tested performance yet, but I wouldn't be surprised if compilation takes longer  ## Appendix
exe/Preprocessor.hs view
@@ -19,7 +19,7 @@ -} module Main where -import qualified Data.Text.IO as Text+import Data.Text.IO qualified as Text import GHC.IO.Encoding (setLocaleEncoding, utf8) import System.Environment (getArgs) import Test.Tasty.AutoCollect (processFile)
src/Test/Tasty/AutoCollect.hs view
@@ -5,7 +5,7 @@ ) where  import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text  import Test.Tasty.AutoCollect.Config import Test.Tasty.AutoCollect.GenerateMain
src/Test/Tasty/AutoCollect/Config.hs view
@@ -21,8 +21,8 @@ import Data.Functor.Identity (Identity) import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text+import Data.Text qualified as Text+import Data.Text.IO qualified as Text import System.FilePath (takeDirectory, (</>))  {----- Configuration -----}
src/Test/Tasty/AutoCollect/Constants.hs view
@@ -9,7 +9,7 @@ ) where  import Data.Char (toLower)-import qualified Data.Text as Text+import Data.Text qualified as Text  import Test.Tasty.AutoCollect.Utils.Text
src/Test/Tasty/AutoCollect/ConvertTest.hs view
@@ -11,30 +11,37 @@ import Control.Arrow ((&&&)) import Control.Monad (unless, zipWithM) import Control.Monad.Trans.State.Strict (State)-import qualified Control.Monad.Trans.State.Strict as State+import Control.Monad.Trans.State.Strict qualified as State import Data.Foldable (toList)-import qualified Data.List.NonEmpty as NonEmpty+import Data.List.NonEmpty qualified as NonEmpty import Data.Maybe (isNothing) import Data.Sequence (Seq)-import qualified Data.Sequence as Seq-import qualified Data.Text as Text+import Data.Sequence qualified as Seq+import Data.Text qualified as Text  import Test.Tasty.AutoCollect.Constants import Test.Tasty.AutoCollect.Error import Test.Tasty.AutoCollect.ExternalNames-import Test.Tasty.AutoCollect.GHC+import Test.Tasty.AutoCollect.GHC hiding (comment)  -- | The plugin to convert a test file. Injected by the preprocessor. plugin :: Plugin plugin =-  setKeepRawTokenStream-    defaultPlugin-      { pluginRecompile = purePlugin-      , parsedResultAction = \_ _ result -> do-          env <- getHscEnv-          names <- liftIO $ loadExternalNames env-          pure $ withParsedResultModule result (transformTestModule names)-      }+  defaultPlugin+    { driverPlugin = \_ env ->+        pure+          env+            { hsc_dflags = hsc_dflags env `gopt_set` Opt_KeepRawTokenStream+            }+    , pluginRecompile = purePlugin+    , parsedResultAction = \_ _ result -> do+        env <- getHscEnv+        names <- liftIO $ loadExternalNames env+        pure+          result+            { parsedResultModule = transformTestModule names $ parsedResultModule result+            }+    }  -- | Transforms a test module of the form --@@ -76,7 +83,7 @@      -- Replace "{- AUTOCOLLECT.TEST.export -}" with `tests` in the export list     updateExports lexports-      | Just exportSpan <- firstLocatedWhere getTestExportAnnSrcSpan (getExportComments parsedModl lexports) =+      | Just exportSpan <- firstLocatedWhere getTestExportAnnSrcSpan (getExportComments lexports) =           (L (toSrcAnnA exportSpan) exportIE :) <$> lexports       | otherwise =           lexports@@ -84,12 +91,12 @@       if isTestExportComment comment         then Just loc         else Nothing-    exportIE = IEVar NoExtField $ genLoc $ mkIEName testListName+    exportIE = mkIEVar $ genLoc $ mkIEName testListName      -- Generate the `tests` list     mkTestsList :: [LocatedN RdrName] -> [LHsDecl GhcPs]     mkTestsList testNames =-      let testsList = genLoc $ mkExplicitList $ map lhsvar testNames+      let testsList = genLoc $ ExplicitList noAnn $ map lhsvar testNames        in [ genLoc $ genFuncSig testListName $ getListOfTestTreeType names           , genLoc $ genFuncDecl testListName [] (flattenTestList testsList) Nothing           ]@@ -212,7 +219,7 @@           withTestModifier names modifier loc $             convertSingleTestBody testType' body -    singleExpr = genLoc . mkExplicitList . (: [])+    singleExpr = genLoc . ExplicitList noAnn . (: [])  -- | Identifier for the generated `tests` list. testListName :: LocatedN RdrName
src/Test/Tasty/AutoCollect/ExternalNames.hs view
@@ -39,5 +39,5 @@   pure ExternalNames{..}   where     loadName name =-      thNameToGhcNameIO env (hsc_NC env) name+      thNameToGhcNameIO (hsc_NC env) name         >>= maybe (autocollectError $ "Could not get Name for " ++ show name) pure
src/Test/Tasty/AutoCollect/GHC.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}  module Test.Tasty.AutoCollect.GHC (@@ -9,6 +10,7 @@    -- * Parsers   parseLitStrPat,+  parseSigWcType,    -- * Builders   genFuncSig,@@ -17,9 +19,14 @@   mkHsVar,   mkHsAppTypes,   mkHsTyVar,+  mkLet,   mkExprTypeSig,   mkHsLitString, +  -- * Annotation utilities+  toSrcAnnA,+  getExportComments,+   -- * Located utilities   genLoc,   firstLocatedWhere,@@ -36,9 +43,17 @@ import Data.Foldable (foldl') import Data.List (sortOn) import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)-import qualified GHC.Types.Name.Occurrence as NameSpace (tcName, varName)+import Data.Text qualified as Text+import GHC.Data.Strict qualified as Strict+import GHC.Types.Name.Occurrence qualified as NameSpace (tcName, varName) -import Test.Tasty.AutoCollect.GHC.Shim+import Test.Tasty.AutoCollect.GHC.Shim hiding (+  mkHsAppTypes,+  mkLet,+  msg,+  showPpr,+ )+import Test.Tasty.AutoCollect.Utils.Text (withoutPrefix, withoutSuffix)  {----- Output helpers -----} @@ -52,6 +67,16 @@   L _ (LitPat _ (HsString _ s)) -> Just (unpackFS s)   _ -> Nothing +parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType+parseSigWcType (HsWC _ (L _ (HsSig _ _ ltype))) = parseType ltype++parseType :: LHsType GhcPs -> Maybe ParsedType+parseType (L _ ty) =+  case ty of+    HsTyVar _ flag name -> Just $ TypeVar flag name+    HsListTy _ t -> TypeList <$> parseType t+    _ -> Nothing+ {----- Builders -----}  genFuncSig :: LocatedN RdrName -> LHsType GhcPs -> HsDecl GhcPs@@ -64,7 +89,7 @@ -- | Make simple function declaration of the form `<funcName> <funcArgs> = <funcBody> where <funcWhere>` genFuncDecl :: LocatedN RdrName -> [LPat GhcPs] -> LHsExpr GhcPs -> Maybe (HsLocalBinds GhcPs) -> HsDecl GhcPs genFuncDecl funcName funcArgs funcBody mFuncWhere =-  ValD NoExtField . mkFunBind Generated funcName $+  ValD NoExtField . mkFunBind generatedOrigin funcName $     [ mkMatch (mkPrefixFunRhs funcName) funcArgs funcBody funcWhere     ]   where@@ -82,6 +107,9 @@ mkHsTyVar :: Name -> LHsType GhcPs mkHsTyVar = genLoc . HsTyVar noAnn NotPromoted . genLoc . getRdrName +mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs+mkLet binds expr = HsLet noAnn (L NoTokenLoc HsTok) binds (L NoTokenLoc HsTok) expr+ -- | mkExprTypeSig e t = [| $e :: $t |] mkExprTypeSig :: LHsExpr GhcPs -> LHsType GhcPs -> LHsExpr GhcPs mkExprTypeSig e t =@@ -91,10 +119,28 @@ mkHsLitString :: String -> LHsExpr GhcPs mkHsLitString = genLoc . HsLit noAnn . mkHsString +{----- Annotation utilities -----}++toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA+toSrcAnnA rss = SrcSpanAnn noAnn (RealSrcSpan rss Strict.Nothing)++-- | Get the contents of all comments in the given hsmodExports list.+getExportComments :: LocatedL [LIE GhcPs] -> [RealLocated String]+getExportComments = map fromLEpaComment . priorComments . epAnnComments . ann . getLoc+  where+    fromLEpaComment (L Anchor{anchor} EpaComment{ac_tok}) =+      L anchor $ (Text.unpack . Text.strip . unwrap) ac_tok+    unwrap = \case+      EpaDocComment doc -> Text.pack $ renderHsDocString doc+      EpaDocOptions s -> Text.pack s+      EpaLineComment s -> withoutPrefix "--" $ Text.pack s+      EpaBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s+      EpaEofComment -> ""+ {----- Located utilities -----}  genLoc :: e -> GenLocated (SrcAnn ann) e-genLoc = L generatedSrcAnn+genLoc = L (SrcSpanAnn noAnn generatedSrcSpan)  firstLocatedWhere :: (Ord l) => (GenLocated l e -> Maybe a) -> [GenLocated l e] -> Maybe a firstLocatedWhere f = listToMaybe . mapMaybe f . sortOn getLoc
src/Test/Tasty/AutoCollect/GHC/Shim.hs view
@@ -4,12 +4,10 @@  -- GHC-specific shims import Test.Tasty.AutoCollect.GHC.Shim_Common as X-#if __GLASGOW_HASKELL__ == 900-import Test.Tasty.AutoCollect.GHC.Shim_9_0 as X-#elif __GLASGOW_HASKELL__ == 902-import Test.Tasty.AutoCollect.GHC.Shim_9_2 as X-#elif __GLASGOW_HASKELL__ == 904+#if __GLASGOW_HASKELL__ == 904 import Test.Tasty.AutoCollect.GHC.Shim_9_4 as X #elif __GLASGOW_HASKELL__ == 906 import Test.Tasty.AutoCollect.GHC.Shim_9_6 as X+#elif __GLASGOW_HASKELL__ == 908+import Test.Tasty.AutoCollect.GHC.Shim_9_8 as X #endif
− src/Test/Tasty/AutoCollect/GHC/Shim_9_0.hs 
@@ -1,190 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}--module Test.Tasty.AutoCollect.GHC.Shim_9_0 (-  -- * Re-exports-  module X,--  -- * Compat--  -- ** Plugin-  setKeepRawTokenStream,-  withParsedResultModule,--  -- ** Annotations-  getExportComments,-  generatedSrcAnn,-  toSrcAnnA,--  -- ** Decl-  parseDecl,--  -- ** Type-  parseSigWcType,-  parseType,--  -- ** Expr-  mkExplicitList,-  mkExplicitTuple,-  mkLet,-  mkHsAppType,--  -- ** Name-  mkIEName,--  -- * Backports-  SrcAnn,-  SrcSpanAnn',-  LocatedN,-  getLocA,-  mkMatch,-  noAnn,-  hsTypeToHsSigType,-  hsTypeToHsSigWcType,-  thNameToGhcNameIO,-) where---- Re-exports-import GHC.Driver.Main as X (getHscEnv)-import GHC.Hs as X hiding (mkHsAppType, mkHsAppTypes, mkMatch)-import GHC.Parser.Annotation as X (AnnotationComment (..))-import GHC.Plugins as X hiding (getHscEnv, mkLet, showPpr, varName)-import GHC.Types.Name.Cache as X (NameCache)--import Data.IORef (IORef)-import qualified Data.Text as Text-import qualified GHC.Hs.Utils as GHC (mkMatch)-import GHC.Parser.Annotation (getAnnotationComments)-import qualified Language.Haskell.TH as TH--import Test.Tasty.AutoCollect.GHC.Shim_Common-import Test.Tasty.AutoCollect.Utils.Text--{----- Compat / Plugin -----}--setKeepRawTokenStream :: Plugin -> Plugin-setKeepRawTokenStream plugin =-  plugin-    { dynflagsPlugin = \_ df ->-        pure $ df `gopt_set` Opt_KeepRawTokenStream-    }--withParsedResultModule :: HsParsedModule -> (HsParsedModule -> HsParsedModule) -> HsParsedModule-withParsedResultModule = flip ($)--{----- Compat / Annotations -----}---- | Get the contents of all comments in the given hsmodExports list.-getExportComments :: HsParsedModule -> Located [LIE GhcPs] -> [RealLocated String]-getExportComments parsedModl = map fromRLAnnotationComment . getCommentsAt . getLoc-  where-    getCommentsAt = \case-      RealSrcSpan x _ -> getAnnotationComments (hpm_annotations parsedModl) x-      UnhelpfulSpan _ -> []-    fromRLAnnotationComment (L rss comment) =-      L rss $ (Text.unpack . Text.strip . unwrap) comment-    unwrap = \case-      AnnDocCommentNext s -> withoutPrefix "-- |" $ Text.pack s-      AnnDocCommentPrev s -> withoutPrefix "-- ^" $ Text.pack s-      AnnDocCommentNamed s -> withoutPrefix "-- $" $ Text.pack s-      AnnDocSection _ s -> Text.pack s-      AnnDocOptions s -> Text.pack s-      AnnLineComment s -> withoutPrefix "--" $ Text.pack s-      AnnBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s--generatedSrcAnn :: SrcSpan-generatedSrcAnn = generatedSrcSpan--toSrcAnnA :: RealSrcSpan -> SrcSpan-toSrcAnnA x = RealSrcSpan x Nothing--{----- Compat / Decl -----}--parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl-parseDecl (L _ decl) =-  case decl of-    SigD _ (TypeSig _ names ty) -> Just $ FuncSig names ty-    ValD _ (FunBind _ name MG{mg_alts = L _ matches} _) ->-      Just $ FuncDef name $ map (fmap parseFuncSingleDef) matches-    _ -> Nothing-  where-    parseFuncSingleDef Match{m_pats, m_grhss = GRHSs _ bodys whereClause} =-      FuncSingleDef-        { funcDefArgs = m_pats-        , funcDefGuards = map parseFuncGuardedBody bodys-        , funcDefWhereClause = unLoc whereClause-        }-    parseFuncGuardedBody (L _ (GRHS _ guards body)) =-      FuncGuardedBody guards body--{----- Compat / Type -----}--parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType-parseSigWcType (HsWC _ (HsIB _ ltype)) = parseType ltype--parseType :: LHsType GhcPs -> Maybe ParsedType-parseType (L _ ty) =-  case ty of-    HsTyVar _ flag name -> Just $ TypeVar flag name-    HsListTy _ t -> TypeList <$> parseType t-    _ -> Nothing--{----- Compat / Expr -----}--mkExplicitList :: [LHsExpr GhcPs] -> HsExpr GhcPs-mkExplicitList = ExplicitList noExtField Nothing--mkExplicitTuple :: [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs-mkExplicitTuple = ExplicitTuple noAnn . map (L generatedSrcAnn)--mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkLet binds expr = HsLet noExtField (L generatedSrcAnn binds) expr--mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs-mkHsAppType e t = HsAppType noExtField e (HsWC noExtField t)--{----- Compat / Name -----}--mkIEName :: LocatedN RdrName -> IEWrappedName RdrName-mkIEName = IEName--{----- Backports -----}--type SrcAnn ann = SrcSpan-type SrcSpanAnn' a = SrcSpan-type LocatedN = Located--getLocA :: Located e -> SrcSpan-getLocA = getLoc--mkMatch :: HsMatchContext GhcPs -> [LPat GhcPs] -> LHsExpr GhcPs -> HsLocalBinds GhcPs -> LMatch GhcPs (LHsExpr GhcPs)-mkMatch ctxt pats expr lbinds = GHC.mkMatch ctxt pats expr (L generatedSrcAnn lbinds)--noAnn :: NoExtField-noAnn = NoExtField--hsTypeToHsSigType :: LHsType GhcPs -> LHsSigType GhcPs-hsTypeToHsSigType = mkLHsSigType--hsTypeToHsSigWcType :: LHsType GhcPs -> LHsSigWcType GhcPs-hsTypeToHsSigWcType = mkLHsSigWcType---- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8492-thNameToGhcNameIO :: HscEnv -> IORef NameCache -> TH.Name -> IO (Maybe Name)-thNameToGhcNameIO hscEnv cache name =-  fmap fst-    . runCoreM-      hscEnv{hsc_NC = cache}-      (unused "cr_rule_base")-      (strict '.')-      (unused "cr_module")-      (strict mempty)-      (unused "cr_print_unqual")-      (unused "cr_loc")-    $ thNameToGhcName name-  where-    unused msg = error $ "unexpectedly used: " ++ msg--    -- marks fields that are strict, so we can't use `unused`-    strict = id
− src/Test/Tasty/AutoCollect/GHC/Shim_9_2.hs 
@@ -1,169 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Test.Tasty.AutoCollect.GHC.Shim_9_2 (-  -- * Re-exports-  module X,--  -- * Compat--  -- ** Plugin-  setKeepRawTokenStream,-  withParsedResultModule,--  -- ** Annotations-  generatedSrcAnn,-  getExportComments,-  toSrcAnnA,--  -- ** Decl-  parseDecl,--  -- ** Type-  parseSigWcType,-  parseType,--  -- ** Expr-  mkExplicitList,-  mkExplicitTuple,-  mkLet,-  mkHsAppType,--  -- ** Name-  mkIEName,--  -- * Backports-  thNameToGhcNameIO,-) where---- Re-exports-import GHC.Driver.Main as X (getHscEnv)-import GHC.Hs as X hiding (comment, mkHsAppType, mkHsAppTypes)-import GHC.Plugins as X hiding (-  AnnBind (..),-  AnnExpr' (..),-  getHscEnv,-  mkLet,-  showPpr,-  varName,- )-import GHC.Types.Name.Cache as X (NameCache)--import Data.IORef (IORef)-import qualified Data.Text as Text-import qualified Language.Haskell.TH as TH--import Test.Tasty.AutoCollect.GHC.Shim_Common-import Test.Tasty.AutoCollect.Utils.Text--{----- Compat / Plugin -----}--setKeepRawTokenStream :: Plugin -> Plugin-setKeepRawTokenStream plugin =-  plugin-    { driverPlugin = \_ env ->-        pure-          env-            { hsc_dflags = hsc_dflags env `gopt_set` Opt_KeepRawTokenStream-            }-    }--withParsedResultModule :: HsParsedModule -> (HsParsedModule -> HsParsedModule) -> HsParsedModule-withParsedResultModule = flip ($)--{----- Compat / Annotations -----}---- | Get the contents of all comments in the given hsmodExports list.-getExportComments :: HsParsedModule -> LocatedL [LIE GhcPs] -> [RealLocated String]-getExportComments _ = map fromLEpaComment . priorComments . epAnnComments . ann . getLoc-  where-    fromLEpaComment (L Anchor{anchor} EpaComment{ac_tok}) =-      L anchor $ (Text.unpack . Text.strip . unwrap) ac_tok-    unwrap = \case-      EpaDocCommentNext s -> withoutPrefix "-- |" $ Text.pack s-      EpaDocCommentPrev s -> withoutPrefix "-- ^" $ Text.pack s-      EpaDocCommentNamed s -> withoutPrefix "-- $" $ Text.pack s-      EpaDocSection _ s -> Text.pack s-      EpaDocOptions s -> Text.pack s-      EpaLineComment s -> withoutPrefix "--" $ Text.pack s-      EpaBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s-      EpaEofComment -> ""--generatedSrcAnn :: SrcAnn ann-generatedSrcAnn = SrcSpanAnn noAnn generatedSrcSpan--toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA-toSrcAnnA rss = SrcSpanAnn noAnn (RealSrcSpan rss Nothing)--{----- Compat / Decl -----}--parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl-parseDecl (L _ decl) =-  case decl of-    SigD _ (TypeSig _ names ty) -> Just $ FuncSig names ty-    ValD _ (FunBind _ name MG{mg_alts = L _ matches} _) ->-      Just $ FuncDef name $ map (fmap parseFuncSingleDef) matches-    _ -> Nothing-  where-    parseFuncSingleDef Match{m_pats, m_grhss = GRHSs _ bodys whereClause} =-      FuncSingleDef-        { funcDefArgs = m_pats-        , funcDefGuards = map parseFuncGuardedBody bodys-        , funcDefWhereClause = whereClause-        }-    parseFuncGuardedBody (L _ (GRHS _ guards body)) =-      FuncGuardedBody guards body--{----- Compat / Type -----}--parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType-parseSigWcType (HsWC _ (L _ (HsSig _ _ ltype))) = parseType ltype--parseType :: LHsType GhcPs -> Maybe ParsedType-parseType (L _ ty) =-  case ty of-    HsTyVar _ flag name -> Just $ TypeVar flag name-    HsListTy _ t -> TypeList <$> parseType t-    _ -> Nothing--{----- Compat / Expr -----}--mkExplicitList :: [LHsExpr GhcPs] -> HsExpr GhcPs-mkExplicitList = ExplicitList noAnn--mkExplicitTuple :: [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs-mkExplicitTuple = ExplicitTuple noAnn--mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkLet binds expr = HsLet noAnn binds expr--mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs-mkHsAppType e t = HsAppType generatedSrcSpan e (HsWC noExtField t)--{----- Compat / Name -----}--mkIEName :: LocatedN RdrName -> IEWrappedName RdrName-mkIEName = IEName--{----- Backports -----}---- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/8492-thNameToGhcNameIO :: HscEnv -> IORef NameCache -> TH.Name -> IO (Maybe Name)-thNameToGhcNameIO hscEnv cache name =-  fmap fst-    . runCoreM-      hscEnv{hsc_NC = cache}-      (unused "cr_rule_base")-      (strict '.')-      (unused "cr_module")-      (strict mempty)-      (unused "cr_print_unqual")-      (unused "cr_loc")-    $ thNameToGhcName name-  where-    unused msg = error $ "unexpectedly used: " ++ msg--    -- marks fields that are strict, so we can't use `unused`-    strict = id
src/Test/Tasty/AutoCollect/GHC/Shim_9_4.hs view
@@ -9,94 +9,30 @@    -- * Compat -  -- ** Plugin-  setKeepRawTokenStream,-  withParsedResultModule,--  -- ** Annotations-  generatedSrcAnn,-  getExportComments,-  toSrcAnnA,-   -- ** Decl   parseDecl,--  -- ** Type-  parseSigWcType,-  parseType,+  generatedOrigin,    -- ** Expr-  mkExplicitList,-  mkExplicitTuple,-  mkLet,   mkHsAppType,    -- ** Name+  mkIEVar,   mkIEName,--  -- * Backports-  thNameToGhcNameIO, ) where  -- Re-exports import GHC.Driver.Main as X (getHscEnv)-import GHC.Hs as X hiding (comment, mkHsAppType, mkHsAppTypes)+import GHC.Hs as X hiding (mkHsAppType) import GHC.Plugins as X hiding (   AnnBind (..),   AnnExpr' (..),   getHscEnv,-  mkLet,-  msg,-  showPpr,-  thNameToGhcNameIO,-  varName,  ) import GHC.Types.Name.Cache as X (NameCache) -import qualified Data.Text as Text-import qualified GHC.Data.Strict as Strict-import qualified GHC.Plugins as GHC (thNameToGhcNameIO)-import qualified Language.Haskell.TH as TH- import Test.Tasty.AutoCollect.GHC.Shim_Common-import Test.Tasty.AutoCollect.Utils.Text -{----- Compat / Plugin -----}--setKeepRawTokenStream :: Plugin -> Plugin-setKeepRawTokenStream plugin =-  plugin-    { driverPlugin = \_ env ->-        pure-          env-            { hsc_dflags = hsc_dflags env `gopt_set` Opt_KeepRawTokenStream-            }-    }--withParsedResultModule :: ParsedResult -> (HsParsedModule -> HsParsedModule) -> ParsedResult-withParsedResultModule result f = result{parsedResultModule = f $ parsedResultModule result}--{----- Compat / Annotations -----}---- | Get the contents of all comments in the given hsmodExports list.-getExportComments :: HsParsedModule -> LocatedL [LIE GhcPs] -> [RealLocated String]-getExportComments _ = map fromLEpaComment . priorComments . epAnnComments . ann . getLoc-  where-    fromLEpaComment (L Anchor{anchor} EpaComment{ac_tok}) =-      L anchor $ (Text.unpack . Text.strip . unwrap) ac_tok-    unwrap = \case-      EpaDocComment doc -> Text.pack $ renderHsDocString doc-      EpaDocOptions s -> Text.pack s-      EpaLineComment s -> withoutPrefix "--" $ Text.pack s-      EpaBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s-      EpaEofComment -> ""--generatedSrcAnn :: SrcAnn ann-generatedSrcAnn = SrcSpanAnn noAnn generatedSrcSpan--toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA-toSrcAnnA rss = SrcSpanAnn noAnn (RealSrcSpan rss Strict.Nothing)- {----- Compat / Decl -----}  parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl@@ -116,38 +52,18 @@     parseFuncGuardedBody (L _ (GRHS _ guards body)) =       FuncGuardedBody guards body -{----- Compat / Type -----}--parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType-parseSigWcType (HsWC _ (L _ (HsSig _ _ ltype))) = parseType ltype--parseType :: LHsType GhcPs -> Maybe ParsedType-parseType (L _ ty) =-  case ty of-    HsTyVar _ flag name -> Just $ TypeVar flag name-    HsListTy _ t -> TypeList <$> parseType t-    _ -> Nothing+generatedOrigin :: Origin+generatedOrigin = Generated  {----- Compat / Expr -----} -mkExplicitList :: [LHsExpr GhcPs] -> HsExpr GhcPs-mkExplicitList = ExplicitList noAnn--mkExplicitTuple :: [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs-mkExplicitTuple = ExplicitTuple noAnn--mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkLet binds expr = HsLet noAnn (L NoTokenLoc HsTok) binds (L NoTokenLoc HsTok) expr- mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs mkHsAppType e t = HsAppType generatedSrcSpan e (HsWC noExtField t)  {----- Compat / Name -----} +mkIEVar :: LIEWrappedName (IdP GhcPs) -> IE GhcPs+mkIEVar = IEVar noExtField+ mkIEName :: LocatedN RdrName -> IEWrappedName RdrName mkIEName = IEName--{----- Backports -----}--thNameToGhcNameIO :: HscEnv -> NameCache -> TH.Name -> IO (Maybe Name)-thNameToGhcNameIO _ = GHC.thNameToGhcNameIO
src/Test/Tasty/AutoCollect/GHC/Shim_9_6.hs view
@@ -9,94 +9,30 @@    -- * Compat -  -- ** Plugin-  setKeepRawTokenStream,-  withParsedResultModule,--  -- ** Annotations-  generatedSrcAnn,-  getExportComments,-  toSrcAnnA,-   -- ** Decl   parseDecl,--  -- ** Type-  parseSigWcType,-  parseType,+  generatedOrigin,    -- ** Expr-  mkExplicitList,-  mkExplicitTuple,-  mkLet,   mkHsAppType,    -- ** Name+  mkIEVar,   mkIEName,--  -- * Backports-  thNameToGhcNameIO, ) where  -- Re-exports import GHC.Driver.Main as X (getHscEnv)-import GHC.Hs as X hiding (comment, mkHsAppType, mkHsAppTypes)+import GHC.Hs as X hiding (mkHsAppType) import GHC.Plugins as X hiding (   AnnBind (..),   AnnExpr' (..),   getHscEnv,-  mkLet,-  msg,-  showPpr,-  thNameToGhcNameIO,-  varName,  ) import GHC.Types.Name.Cache as X (NameCache) -import qualified Data.Text as Text-import qualified GHC.Data.Strict as Strict-import qualified GHC.Plugins as GHC (thNameToGhcNameIO)-import qualified Language.Haskell.TH as TH- import Test.Tasty.AutoCollect.GHC.Shim_Common-import Test.Tasty.AutoCollect.Utils.Text -{----- Compat / Plugin -----}--setKeepRawTokenStream :: Plugin -> Plugin-setKeepRawTokenStream plugin =-  plugin-    { driverPlugin = \_ env ->-        pure-          env-            { hsc_dflags = hsc_dflags env `gopt_set` Opt_KeepRawTokenStream-            }-    }--withParsedResultModule :: ParsedResult -> (HsParsedModule -> HsParsedModule) -> ParsedResult-withParsedResultModule result f = result{parsedResultModule = f $ parsedResultModule result}--{----- Compat / Annotations -----}---- | Get the contents of all comments in the given hsmodExports list.-getExportComments :: HsParsedModule -> LocatedL [LIE GhcPs] -> [RealLocated String]-getExportComments _ = map fromLEpaComment . priorComments . epAnnComments . ann . getLoc-  where-    fromLEpaComment (L Anchor{anchor} EpaComment{ac_tok}) =-      L anchor $ (Text.unpack . Text.strip . unwrap) ac_tok-    unwrap = \case-      EpaDocComment doc -> Text.pack $ renderHsDocString doc-      EpaDocOptions s -> Text.pack s-      EpaLineComment s -> withoutPrefix "--" $ Text.pack s-      EpaBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s-      EpaEofComment -> ""--generatedSrcAnn :: SrcAnn ann-generatedSrcAnn = SrcSpanAnn noAnn generatedSrcSpan--toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA-toSrcAnnA rss = SrcSpanAnn noAnn (RealSrcSpan rss Strict.Nothing)- {----- Compat / Decl -----}  parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl@@ -116,41 +52,18 @@     parseFuncGuardedBody (L _ (GRHS _ guards body)) =       FuncGuardedBody guards body -{----- Compat / Type -----}--parseSigWcType :: LHsSigWcType GhcPs -> Maybe ParsedType-parseSigWcType (HsWC _ (L _ (HsSig _ _ ltype))) = parseType ltype--parseType :: LHsType GhcPs -> Maybe ParsedType-parseType (L _ ty) =-  case ty of-    HsTyVar _ flag name -> Just $ TypeVar flag name-    HsListTy _ t -> TypeList <$> parseType t-    _ -> Nothing+generatedOrigin :: Origin+generatedOrigin = Generated  {----- Compat / Expr -----} -mkExplicitList :: [LHsExpr GhcPs] -> HsExpr GhcPs-mkExplicitList = ExplicitList noAnn--mkExplicitTuple :: [HsTupArg GhcPs] -> Boxity -> HsExpr GhcPs-mkExplicitTuple = ExplicitTuple noAnn--mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkLet binds expr = HsLet noAnn tokenLoc binds tokenLoc expr- mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs-mkHsAppType e t = HsAppType noExtField e tokenLoc (HsWC noExtField t)--tokenLoc :: LHsToken tok GhcPs-tokenLoc = L NoTokenLoc HsTok+mkHsAppType e t = HsAppType noExtField e (L NoTokenLoc HsTok) (HsWC noExtField t)  {----- Compat / Name -----} +mkIEVar :: LIEWrappedName GhcPs -> IE GhcPs+mkIEVar = IEVar noExtField+ mkIEName :: LocatedN RdrName -> IEWrappedName GhcPs mkIEName = IEName noExtField--{----- Backports -----}--thNameToGhcNameIO :: HscEnv -> NameCache -> TH.Name -> IO (Maybe Name)-thNameToGhcNameIO _ = GHC.thNameToGhcNameIO
+ src/Test/Tasty/AutoCollect/GHC/Shim_9_8.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Tasty.AutoCollect.GHC.Shim_9_8 (+  -- * Re-exports+  module X,++  -- * Compat++  -- ** Decl+  parseDecl,+  generatedOrigin,++  -- ** Expr+  mkHsAppType,++  -- ** Name+  mkIEVar,+  mkIEName,+) where++-- Re-exports+import GHC.Driver.Main as X (getHscEnv)+import GHC.Hs as X hiding (mkHsAppType)+import GHC.Plugins as X hiding (+  AnnBind (..),+  AnnExpr' (..),+  getHscEnv,+ )+import GHC.Types.Name.Cache as X (NameCache)++import Test.Tasty.AutoCollect.GHC.Shim_Common++{----- Compat / Decl -----}++parseDecl :: LHsDecl GhcPs -> Maybe ParsedDecl+parseDecl (L _ decl) =+  case decl of+    SigD _ (TypeSig _ names ty) -> Just $ FuncSig names ty+    ValD _ (FunBind _ name MG{mg_alts = L _ matches}) ->+      Just $ FuncDef name $ map (fmap parseFuncSingleDef) matches+    _ -> Nothing+  where+    parseFuncSingleDef Match{m_pats, m_grhss = GRHSs _ bodys whereClause} =+      FuncSingleDef+        { funcDefArgs = m_pats+        , funcDefGuards = map parseFuncGuardedBody bodys+        , funcDefWhereClause = whereClause+        }+    parseFuncGuardedBody (L _ (GRHS _ guards body)) =+      FuncGuardedBody guards body++generatedOrigin :: Origin+generatedOrigin = Generated DoPmc++{----- Compat / Expr -----}++mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs+mkHsAppType e t = HsAppType noExtField e (L NoTokenLoc HsTok) (HsWC noExtField t)++{----- Compat / Name -----}++mkIEVar :: LIEWrappedName GhcPs -> IE GhcPs+mkIEVar = IEVar Nothing++mkIEName :: LocatedN RdrName -> IEWrappedName GhcPs+mkIEName = IEName noExtField
src/Test/Tasty/AutoCollect/GHC/Shim_Common.hs view
@@ -12,14 +12,6 @@ import GHC.Types.Basic (PromotionFlag) #endif import GHC.Types.Name.Reader (RdrName)-#if __GLASGOW_HASKELL__ < 902-import GHC.Types.SrcLoc (Located)-#endif--#if __GLASGOW_HASKELL__ < 902-type LocatedA = Located-type LocatedN = Located-#endif  data ParsedDecl   = FuncSig [LocatedN RdrName] (LHsSigWcType GhcPs)
src/Test/Tasty/AutoCollect/GenerateMain.hs view
@@ -7,14 +7,14 @@ ) where  import Control.Monad (guard)-import qualified Data.ByteString as ByteString+import Data.ByteString qualified as ByteString import Data.Char (isDigit, isLower, isUpper) import Data.List (sortOn)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.Encoding as Text+import Data.Text qualified as Text+import Data.Text.Encoding qualified as Text import System.Directory (doesDirectoryExist, listDirectory) import System.FilePath (makeRelative, splitExtensions, takeDirectory, (</>)) @@ -23,7 +23,7 @@ import Test.Tasty.AutoCollect.Error import Test.Tasty.AutoCollect.ModuleType import Test.Tasty.AutoCollect.Utils.Text-import qualified Test.Tasty.AutoCollect.Utils.TreeMap as TreeMap+import Test.Tasty.AutoCollect.Utils.TreeMap qualified as TreeMap  generateMainModule :: AutoCollectConfig -> FilePath -> Text -> IO Text generateMainModule cfg path originalMain = do
src/Test/Tasty/AutoCollect/ModuleType.hs view
@@ -7,7 +7,7 @@  import Data.Char (isSpace) import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text  import Test.Tasty.AutoCollect.Config import Test.Tasty.AutoCollect.Constants
src/Test/Tasty/AutoCollect/Utils/Text.hs view
@@ -10,7 +10,7 @@  import Data.Maybe (fromMaybe) import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text  withoutPrefix :: Text -> Text -> Text withoutPrefix pre s = fromMaybe s $ Text.stripPrefix pre s
src/Test/Tasty/AutoCollect/Utils/TreeMap.hs view
@@ -7,7 +7,7 @@ ) where  import Data.Map.Strict (Map)-import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Data.Maybe (fromMaybe)  data TreeMap k v = TreeMap
tasty-autocollect.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2.+-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack  name:           tasty-autocollect-version:        0.4.1+version:        0.4.2 synopsis:       Autocollection of tasty tests. description:    Autocollection of tasty tests. See README.md for more details. category:       Testing@@ -61,32 +61,31 @@       Test.Tasty.AutoCollect.GHC.Shim_Common   hs-source-dirs:       src+  default-extensions:+      ImportQualifiedPost   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances   build-depends:-      base >=4.14 && <5-    , bytestring >=0.10 && <0.12-    , containers >=0.6.2.1 && <0.7-    , directory >=1.3.6.0 && <2-    , filepath >=1.4.2.1 && <2-    , ghc >=9.0 && <9.7-    , tasty >=1.4.2.1 && <2-    , tasty-expected-failure >=0.11 && <1-    , template-haskell >=2.16 && <2.21-    , text >=1.2.3.2 && <3-    , transformers >=0.5.6.2 && <1+      base >=4.17 && <5+    , bytestring <0.13+    , containers <0.7+    , directory <2+    , filepath <2+    , ghc >=9.4 && <9.9+    , tasty <2+    , tasty-expected-failure <1+    , template-haskell >=2.19 && <2.22+    , text <3+    , transformers <1   default-language: Haskell2010+  if impl(ghc >= 9.8) && impl(ghc < 9.10)+    other-modules:+        Test.Tasty.AutoCollect.GHC.Shim_9_8   if impl(ghc >= 9.6) && impl(ghc < 9.8)     other-modules:         Test.Tasty.AutoCollect.GHC.Shim_9_6   if impl(ghc >= 9.4) && impl(ghc < 9.6)     other-modules:         Test.Tasty.AutoCollect.GHC.Shim_9_4-  if impl(ghc >= 9.2) && impl(ghc < 9.4)-    other-modules:-        Test.Tasty.AutoCollect.GHC.Shim_9_2-  if impl(ghc >= 9.0) && impl(ghc < 9.2)-    other-modules:-        Test.Tasty.AutoCollect.GHC.Shim_9_0  executable tasty-autocollect   main-is: Preprocessor.hs@@ -94,11 +93,13 @@       Paths_tasty_autocollect   hs-source-dirs:       exe+  default-extensions:+      ImportQualifiedPost   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances   build-depends:       base >=4.14 && <5     , tasty-autocollect-    , text >=1.2.3.2 && <3+    , text <3   default-language: Haskell2010  test-suite tasty-autocollect-tests@@ -119,21 +120,23 @@       Paths_tasty_autocollect   hs-source-dirs:       test+  default-extensions:+      ImportQualifiedPost   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances -F -pgmF=tasty-autocollect   build-depends:       base     , bytestring     , containers     , directory-    , explainable-predicates+    , explainable-predicates >=0.1.2.0     , filepath-    , tasty+    , tasty >=1.4.2     , tasty-autocollect     , tasty-golden     , tasty-hunit-    , tasty-quickcheck+    , tasty-quickcheck >=0.8.1     , temporary     , text-    , typed-process+    , typed-process >=0.2.8.0   default-language: Haskell2010   build-tool-depends: tasty-autocollect:tasty-autocollect
test/Examples.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-}  module Examples (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where
test/Test/Tasty/AutoCollect/ConfigTest.hs view
@@ -6,7 +6,7 @@ {-# LANGUAGE ViewPatterns #-}  module Test.Tasty.AutoCollect.ConfigTest (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where @@ -14,8 +14,8 @@ import Data.Bifunctor (first) import Data.Char (isSpace) import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text+import Data.Text qualified as Text+import Data.Text.IO qualified as Text import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory, (</>)) import System.IO.Temp (withSystemTempDirectory)
test/Test/Tasty/AutoCollect/ConvertTestTest.hs view
@@ -3,14 +3,14 @@ {-# LANGUAGE OverloadedStrings #-}  module Test.Tasty.AutoCollect.ConvertTestTest (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where  import Control.Monad (forM_) import Data.Maybe (maybeToList) import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Test.Predicates import Test.Predicates.HUnit import Test.Tasty.HUnit@@ -290,7 +290,7 @@ {----- tasty-expected-failure integration -----}  test =-  testGolden "expectFail succeeds when test fails" "test_expectFail_output.golden" $ do+  testGoldenVersioned "expectFail succeeds when test fails" "test_expectFail_output.golden" $ do     (stdout, _) <-       assertSuccess . runTest $         [ "test_expectFail = testCase \"failing test\" $ 1 @?= 2"@@ -298,7 +298,7 @@     pure (normalizeTestOutput stdout)  test =-  testGolden "expectFailBecause succeeds when test fails" "test_expectFailBecause_output.golden" $ do+  testGoldenVersioned "expectFailBecause succeeds when test fails" "test_expectFailBecause_output.golden" $ do     (stdout, _) <-       assertSuccess . runTest $         [ "test_expectFailBecause \"some reason\" = testCase \"failing test\" $ 1 @?= 2"@@ -314,7 +314,7 @@     pure (normalizeTestOutput stdout)  test =-  testGolden "ignoreTestBecause succeeds when test fails" "test_ignoreTestBecause_output.golden" $ do+  testGoldenVersioned "ignoreTestBecause succeeds when test fails" "test_ignoreTestBecause_output.golden" $ do     (stdout, _) <-       assertSuccess . runTest $         [ "test_ignoreTestBecause \"some reason\" = testCase \"failing test\" $ 1 @?= 2"@@ -322,7 +322,7 @@     pure (normalizeTestOutput stdout)  test =-  testGolden "expected-failure modifiers work on test_batch" "test_batch_expectFailBecause_output.golden" $ do+  testGoldenVersioned "expected-failure modifiers work on test_batch" "test_batch_expectFailBecause_output.golden" $ do     (stdout, _) <-       assertAnyFailure . runTest $         [ "test_batch_expectFailBecause \"some reason\" ="
test/Test/Tasty/AutoCollect/GenerateMainTest.hs view
@@ -2,13 +2,13 @@ {-# LANGUAGE OverloadedStrings #-}  module Test.Tasty.AutoCollect.GenerateMainTest (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where -import qualified Data.ByteString as ByteString+import Data.ByteString qualified as ByteString import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import System.FilePath ((</>)) import Test.Predicates import Test.Predicates.HUnit
test/Test/Tasty/AutoCollect/ModuleTypeTest.hs view
@@ -3,11 +3,11 @@ {-# LANGUAGE TemplateHaskell #-}  module Test.Tasty.AutoCollect.ModuleTypeTest (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where -import qualified Data.Text as Text+import Data.Text qualified as Text import Test.Predicates import Test.Predicates.HUnit import Test.Predicates.QuickCheck
test/Test/Tasty/AutoCollect/Utils/TreeMapTest.hs view
@@ -1,11 +1,11 @@ {- AUTOCOLLECT.TEST -}  module Test.Tasty.AutoCollect.Utils.TreeMapTest (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where -import qualified Data.Map.Strict as Map+import Data.Map.Strict qualified as Map import Test.Tasty.HUnit  import Test.Tasty.AutoCollect.Utils.TreeMap
test/Test/Tasty/Ext/TodoTest.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE OverloadedStrings #-}  module Test.Tasty.Ext.TodoTest (--- AUTOCOLLECT.TEST.export+{- AUTOCOLLECT.TEST.export -}  ) where
test/TestUtils/Golden.hs view
@@ -4,11 +4,14 @@  module TestUtils.Golden (   testGolden,+  testGoldenVersioned, ) where  import Data.Text (Text)-import qualified Data.Text.Lazy as TextL-import qualified Data.Text.Lazy.Encoding as TextL+import Data.Text.Lazy qualified as TextL+import Data.Text.Lazy.Encoding qualified as TextL+import System.Environment (lookupEnv)+import System.IO.Unsafe (unsafePerformIO) import Test.Tasty (TestTree) import Test.Tasty.Golden @@ -18,6 +21,14 @@  testGolden :: String -> FilePath -> IO Text -> TestTree testGolden name fp = goldenVsString name ("test/golden/" ++ fp) . fmap (TextL.encodeUtf8 . TextL.fromStrict . normalizePgmError)++testGoldenVersioned :: String -> FilePath -> IO Text -> TestTree+testGoldenVersioned name fp = testGolden name fp'+  where+    fp' =+      case unsafePerformIO (lookupEnv "TEST_PREFER_OLDEST") of+        Just "1" -> fp <> ".prefer-oldest"+        _ -> fp  -- GHC 9.4 added a prefix to pgmError messages. Normalize old versions to show new format. normalizePgmError :: Text -> Text
test/TestUtils/Integration.hs view
@@ -29,10 +29,10 @@ import Control.Monad (forM_, void) import Data.Char (isDigit) import Data.Text (Text)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text-import qualified Data.Text.Lazy as TextL-import qualified Data.Text.Lazy.Encoding as TextL+import Data.Text qualified as Text+import Data.Text.IO qualified as Text+import Data.Text.Lazy qualified as TextL+import Data.Text.Lazy.Encoding qualified as TextL import System.Directory (createDirectoryIfMissing) import System.FilePath (takeDirectory, (</>)) import System.IO.Temp (withSystemTempDirectory)
test/TestUtils/Predicates.hs view
@@ -6,7 +6,7 @@  import Data.List (intercalate) import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Test.Predicates  -- | A predicate for checking that the given lines of text
test/TestUtils/QuickCheck.hs view
@@ -8,7 +8,7 @@ import Data.Char (toLower, toUpper) import Data.String (IsString) import Data.Text (Text)-import qualified Data.Text as Text+import Data.Text qualified as Text import Test.Tasty.QuickCheck  newtype PrintableText = PrintableText {getPrintableText :: Text}