packages feed

tasty-autocollect 0.4.3 → 0.4.4

raw patch · 13 files changed

+196/−136 lines, 13 filesdep ~basedep ~bytestringdep ~containers

Dependency ranges changed: base, bytestring, containers, directory, filepath, ghc, tasty, tasty-expected-failure, template-haskell, text, transformers

Files

CHANGELOG.md view
@@ -1,3 +1,8 @@+# v0.4.4++* Add support for GHC 9.12+* Drop support for GHC 9.6+ # v0.4.3  * Add support for GHC 9.10
src/Test/Tasty/AutoCollect/ConvertTest.hs view
@@ -98,7 +98,7 @@     mkTestsList testNames =       let testsList = genLoc $ ExplicitList noAnn $ map lhsvar testNames        in [ genLoc $ genFuncSig testListName $ getListOfTestTreeType names-          , genLoc $ genFuncDecl testListName [] (flattenTestList testsList) Nothing+          , genLoc $ genFuncDecl testListName (genLoc []) (flattenTestList testsList) Nothing           ]      flattenTestList testsList =@@ -157,7 +157,7 @@             pure . runConvertTestM state $ do               testBody <- convertSingleTestBody testType body               State.gets testArgs >>= \case-                [] -> pure ()+                L _ [] -> pure ()                 _ -> autocollectError $ "Found extraneous arguments at " ++ getSpanLine loc               pure testBody           _ ->@@ -170,7 +170,7 @@         [ if isNothing mSigInfo             then [genLoc $ genFuncSig testName (getListOfTestTreeType names)]             else []-        , [genFuncDecl testName [] testBody mWhereClause <$ ldecl]+        , [genFuncDecl testName (genLoc []) testBody mWhereClause <$ ldecl]         ]      convertSingleTestBody testType body =@@ -188,16 +188,16 @@            (name, remainingPats) <-             popRemainingArgs >>= \case-              arg : rest | Just s <- parseLitStrPat arg -> pure (s, rest)-              [] -> autocollectError "test_prop requires at least the name of the test"-              arg : _ ->+              L ann (arg : rest) | Just s <- parseLitStrPat arg -> pure (s, L ann rest)+              L _ [] -> autocollectError "test_prop requires at least the name of the test"+              L _ (arg : _) ->                 autocollectError . unlines $                   [ "test_prop expected a String for the name of the test."                   , "Got: " ++ showPpr arg                   ]            let propBody =-                mkHsLam remainingPats $+                mkHsLam (toMatchArgs remainingPats) $                   case mWhereClause of                     Just defs -> genLoc $ mkLet defs body                     Nothing -> body@@ -344,7 +344,7 @@ data ConvertTestState = ConvertTestState   { mSigType :: Maybe (LHsSigWcType GhcPs)   , mWhereClause :: Maybe (HsLocalBinds GhcPs)-  , testArgs :: [LPat GhcPs]+  , testArgs :: LocatedE [LPat GhcPs]   }  runConvertTestM :: ConvertTestState -> ConvertTestM a -> (a, ConvertTestState)@@ -355,15 +355,15 @@   state <- State.get   let (mArg, rest) =         case testArgs state of-          [] -> (Nothing, [])-          arg : args -> (Just arg, args)+          L ann [] -> (Nothing, L ann [])+          L ann (arg : args) -> (Just arg, L ann args)   State.put state{testArgs = rest}   pure mArg -popRemainingArgs :: ConvertTestM [LPat GhcPs]+popRemainingArgs :: ConvertTestM (LocatedE [LPat GhcPs]) popRemainingArgs = do   state@ConvertTestState{testArgs} <- State.get-  State.put state{testArgs = []}+  State.put state{testArgs = genLoc []}   pure testArgs  {----- Test module converter monad -----}
src/Test/Tasty/AutoCollect/GHC.hs view
@@ -69,7 +69,7 @@   where     parseFuncSingleDef Match{m_pats, m_grhss = GRHSs _ bodys whereClause} =       FuncSingleDef-        { funcDefArgs = m_pats+        { funcDefArgs = fromMatchArgs m_pats         , funcDefGuards = map parseFuncGuardedBody bodys         , funcDefWhereClause = whereClause         }@@ -101,10 +101,10 @@     $ funcType  -- | 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 :: LocatedN RdrName -> LocatedE [LPat GhcPs] -> LHsExpr GhcPs -> Maybe (HsLocalBinds GhcPs) -> HsDecl GhcPs genFuncDecl funcName funcArgs funcBody mFuncWhere =   ValD NoExtField . mkFunBind generatedOrigin funcName $-    [ mkMatch (mkPrefixFunRhs funcName) funcArgs funcBody funcWhere+    [ mkMatch (mkPrefixFunRhs funcName noAnn) (toMatchArgs funcArgs) funcBody funcWhere     ]   where     funcWhere = fromMaybe emptyLocalBinds mFuncWhere@@ -130,11 +130,11 @@ {----- Annotation utilities -----}  -- | Get the contents of all comments in the given hsmodExports list.-getExportComments :: LocatedL [LIE GhcPs] -> [RealLocated String]+getExportComments :: LocatedLI [LIE GhcPs] -> [RealLocated String] getExportComments = map fromLEpaComment . priorComments . epAnnComments . getEpAnn   where     fromLEpaComment (L ann EpaComment{ac_tok}) =-      L (anchor ann) $ (Text.unpack . Text.strip . epaCommentTokText) ac_tok+      L (epaLocationRealSrcSpan ann) $ (Text.unpack . Text.strip . epaCommentTokText) ac_tok  {----- Located utilities -----}
src/Test/Tasty/AutoCollect/GHC/Shim.hs view
@@ -4,10 +4,10 @@  -- GHC-specific shims import Test.Tasty.AutoCollect.GHC.Shim_Common as X-#if __GLASGOW_HASKELL__ == 906-import Test.Tasty.AutoCollect.GHC.Shim_9_6 as X-#elif __GLASGOW_HASKELL__ == 908+#if __GLASGOW_HASKELL__ == 908 import Test.Tasty.AutoCollect.GHC.Shim_9_8 as X #elif __GLASGOW_HASKELL__ == 910 import Test.Tasty.AutoCollect.GHC.Shim_9_10 as X+#elif __GLASGOW_HASKELL__ == 912+import Test.Tasty.AutoCollect.GHC.Shim_9_12 as X #endif
src/Test/Tasty/AutoCollect/GHC/Shim_9_10.hs view
@@ -16,20 +16,29 @@   mkHsAppType,   mkLet,   mkHsLitString,+  mkPrefixFunRhs,+  toMatchArgs,+  fromMatchArgs,    -- ** Name   mkIEVar,    -- ** Annotations + Located+  LocatedLI,   getEpAnn,   toSrcAnnA,   genLoc,   epaCommentTokText,+  epaLocationRealSrcSpan, ) where  -- Re-exports import GHC.Driver.Main as X (getHscEnv)-import GHC.Hs as X hiding (mkHsAppType)+import GHC.Hs as X hiding (+  epaLocationRealSrcSpan,+  mkHsAppType,+  mkPrefixFunRhs,+ ) import GHC.Plugins as X hiding (   AnnBind (..),   AnnExpr' (..),@@ -40,6 +49,7 @@  import Data.Text (Text) import Data.Text qualified as Text+import GHC.Hs qualified as GHC  import Test.Tasty.AutoCollect.Utils.Text (withoutPrefix, withoutSuffix) @@ -59,6 +69,15 @@ mkHsLitString :: String -> LHsExpr GhcPs mkHsLitString = genLoc . HsLit noExtField . mkHsString +mkPrefixFunRhs :: fn -> [()] -> HsMatchContext fn+mkPrefixFunRhs fn _ = GHC.mkPrefixFunRhs fn++toMatchArgs :: LocatedE [LPat GhcPs] -> [LPat GhcPs]+toMatchArgs = unLoc++fromMatchArgs :: [LPat GhcPs] -> LocatedE [LPat GhcPs]+fromMatchArgs = genLoc+ {----- Compat / Name -----}  mkIEVar :: LIEWrappedName GhcPs -> IE GhcPs@@ -66,13 +85,15 @@  {----- Compat / Annotations + Located -----} +type LocatedLI = LocatedL+ getEpAnn :: GenLocated (EpAnn ann) e -> EpAnn ann getEpAnn = getLoc  toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA toSrcAnnA rss = EpAnn (realSpanAsAnchor rss) noAnn (EpaComments []) -genLoc :: (NoAnn ann) => e -> GenLocated (EpAnn ann) e+genLoc :: (NoAnn ann) => e -> GenLocated ann e genLoc = L noAnn  epaCommentTokText :: EpaCommentTok -> Text@@ -81,3 +102,6 @@   EpaDocOptions s -> Text.pack s   EpaLineComment s -> withoutPrefix "--" $ Text.pack s   EpaBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s++epaLocationRealSrcSpan :: NoCommentsLocation -> RealSrcSpan+epaLocationRealSrcSpan = anchor
+ src/Test/Tasty/AutoCollect/GHC/Shim_9_12.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Test.Tasty.AutoCollect.GHC.Shim_9_12 (+  -- * Re-exports+  module X,++  -- * Compat++  -- ** Decl+  generatedOrigin,++  -- ** Expr+  mkHsAppType,+  mkLet,+  mkHsLitString,+  mkPrefixFunRhs,+  toMatchArgs,+  fromMatchArgs,++  -- ** Name+  mkIEVar,++  -- ** Annotations + Located+  getEpAnn,+  toSrcAnnA,+  genLoc,+  epaCommentTokText,+) where++-- Re-exports+import GHC.Driver.Main as X (getHscEnv)+import GHC.Hs as X hiding (mkHsAppType, mkPrefixFunRhs)+import GHC.Plugins as X hiding (+  AnnBind (..),+  AnnExpr' (..),+  getHscEnv,+  mkLet,+ )+import GHC.Types.Name.Cache as X (NameCache)++import Data.Text (Text)+import Data.Text qualified as Text+import GHC.Hs qualified as GHC++import Test.Tasty.AutoCollect.Utils.Text (withoutPrefix, withoutSuffix)++{----- Compat / Decl -----}++generatedOrigin :: Origin+generatedOrigin = Generated OtherExpansion DoPmc++{----- Compat / Expr -----}++mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs+mkHsAppType e t = HsAppType NoEpTok e (HsWC noExtField t)++mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs+mkLet binds expr = HsLet (NoEpTok, NoEpTok) binds expr++mkHsLitString :: String -> LHsExpr GhcPs+mkHsLitString = genLoc . HsLit noExtField . mkHsString++mkPrefixFunRhs :: fn -> AnnFunRhs -> HsMatchContext fn+mkPrefixFunRhs = GHC.mkPrefixFunRhs++toMatchArgs :: LocatedE [LPat GhcPs] -> LocatedE [LPat GhcPs]+toMatchArgs = id++fromMatchArgs :: LocatedE [LPat GhcPs] -> LocatedE [LPat GhcPs]+fromMatchArgs = id++{----- Compat / Name -----}++mkIEVar :: LIEWrappedName GhcPs -> IE GhcPs+mkIEVar n = IEVar Nothing n Nothing++{----- Compat / Annotations + Located -----}++getEpAnn :: GenLocated (EpAnn ann) e -> EpAnn ann+getEpAnn = getLoc++toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA+toSrcAnnA rss = EpAnn (realSpanAsAnchor rss) noAnn (EpaComments [])++genLoc :: (NoAnn ann) => e -> GenLocated ann e+genLoc = L noAnn++epaCommentTokText :: EpaCommentTok -> Text+epaCommentTokText = \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
− src/Test/Tasty/AutoCollect/GHC/Shim_9_6.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}--module Test.Tasty.AutoCollect.GHC.Shim_9_6 (-  -- * Re-exports-  module X,--  -- * Compat--  -- ** Decl-  generatedOrigin,--  -- ** Expr-  mkHsAppType,-  mkLet,-  mkHsLitString,--  -- ** Name-  mkIEVar,--  -- ** Annotations + Located-  getEpAnn,-  toSrcAnnA,-  genLoc,-  epaCommentTokText,-) 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,-  mkLet,- )-import GHC.Types.Name.Cache as X (NameCache)--import Data.Text (Text)-import Data.Text qualified as Text-import GHC.Data.Strict qualified as Strict--import Test.Tasty.AutoCollect.Utils.Text (withoutPrefix, withoutSuffix)--{----- Compat / Decl -----}--generatedOrigin :: Origin-generatedOrigin = Generated--{----- Compat / Expr -----}--mkHsAppType :: LHsExpr GhcPs -> LHsType GhcPs -> HsExpr GhcPs-mkHsAppType e t = HsAppType noExtField e (L NoTokenLoc HsTok) (HsWC noExtField t)--mkLet :: HsLocalBinds GhcPs -> LHsExpr GhcPs -> HsExpr GhcPs-mkLet binds expr = HsLet noAnn (L NoTokenLoc HsTok) binds (L NoTokenLoc HsTok) expr--mkHsLitString :: String -> LHsExpr GhcPs-mkHsLitString = genLoc . HsLit noAnn . mkHsString--{----- Compat / Name -----}--mkIEVar :: LIEWrappedName GhcPs -> IE GhcPs-mkIEVar = IEVar noExtField--{----- Compat / Annotations + Located -----}--getEpAnn :: GenLocated (SrcAnn ann) e -> EpAnn ann-getEpAnn = ann . getLoc--toSrcAnnA :: RealSrcSpan -> SrcSpanAnnA-toSrcAnnA rss = SrcSpanAnn noAnn (RealSrcSpan rss Strict.Nothing)--genLoc :: e -> GenLocated (SrcAnn ann) e-genLoc = L (SrcSpanAnn noAnn generatedSrcSpan)--epaCommentTokText :: EpaCommentTok -> Text-epaCommentTokText = \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 -> ""
src/Test/Tasty/AutoCollect/GHC/Shim_9_8.hs view
@@ -16,20 +16,30 @@   mkHsAppType,   mkLet,   mkHsLitString,+  mkPrefixFunRhs,+  toMatchArgs,+  fromMatchArgs,    -- ** Name   mkIEVar,    -- ** Annotations + Located+  LocatedE,+  LocatedLI,   getEpAnn,   toSrcAnnA,   genLoc,   epaCommentTokText,+  epaLocationRealSrcSpan, ) where  -- Re-exports import GHC.Driver.Main as X (getHscEnv)-import GHC.Hs as X hiding (mkHsAppType)+import GHC.Hs as X hiding (+  epaLocationRealSrcSpan,+  mkHsAppType,+  mkPrefixFunRhs,+ ) import GHC.Plugins as X hiding (   AnnBind (..),   AnnExpr' (..),@@ -41,6 +51,7 @@ import Data.Text (Text) import Data.Text qualified as Text import GHC.Data.Strict qualified as Strict+import GHC.Hs qualified as GHC  import Test.Tasty.AutoCollect.Utils.Text (withoutPrefix, withoutSuffix) @@ -60,6 +71,15 @@ mkHsLitString :: String -> LHsExpr GhcPs mkHsLitString = genLoc . HsLit noAnn . mkHsString +mkPrefixFunRhs :: LIdP GhcPs -> EpAnn () -> HsMatchContext GhcPs+mkPrefixFunRhs fn _ = GHC.mkPrefixFunRhs fn++toMatchArgs :: LocatedE [LPat GhcPs] -> [LPat GhcPs]+toMatchArgs = unLoc++fromMatchArgs :: [LPat GhcPs] -> LocatedE [LPat GhcPs]+fromMatchArgs = genLoc+ {----- Compat / Name -----}  mkIEVar :: LIEWrappedName GhcPs -> IE GhcPs@@ -67,6 +87,9 @@  {----- Compat / Annotations + Located -----} +type LocatedE = LocatedL+type LocatedLI = LocatedL+ getEpAnn :: GenLocated (SrcAnn ann) e -> EpAnn ann getEpAnn = ann . getLoc @@ -83,3 +106,6 @@   EpaLineComment s -> withoutPrefix "--" $ Text.pack s   EpaBlockComment s -> withoutPrefix "{-" . withoutSuffix "-}" $ Text.pack s   EpaEofComment -> ""++epaLocationRealSrcSpan :: Anchor -> RealSrcSpan+epaLocationRealSrcSpan = anchor
src/Test/Tasty/AutoCollect/GHC/Shim_Common.hs view
@@ -8,17 +8,18 @@ ) where  import GHC.Hs-#if __GLASGOW_HASKELL__ < 906-import GHC.Types.Basic (PromotionFlag)-#endif import GHC.Types.Name.Reader (RdrName)  data ParsedDecl   = FuncSig [LocatedN RdrName] (LHsSigWcType GhcPs)   | FuncDef (LocatedN RdrName) [LocatedA FuncSingleDef] +#if __GLASGOW_HASKELL__ < 910+type LocatedE = LocatedL+#endif+ data FuncSingleDef = FuncSingleDef-  { funcDefArgs :: [LPat GhcPs]+  { funcDefArgs :: LocatedE [LPat GhcPs]   , funcDefGuards :: [FuncGuardedBody]   , funcDefWhereClause :: HsLocalBinds GhcPs   }
src/Test/Tasty/Ext/Todo.hs view
@@ -5,7 +5,6 @@ ) where  import Data.Proxy (Proxy (..))-import Data.Typeable (Typeable) import Test.Tasty.Options (   IsOption (..),   OptionDescription (..),@@ -22,7 +21,6 @@ import Test.Tasty.Runners (Result (..), TestTree (..))  data TodoTest = TodoTest-  deriving (Typeable)  instance IsTest TodoTest where   run opts _ _ = pure testResult{resultShortDescription = "TODO"}@@ -36,7 +34,6 @@   testOptions = pure [Option (Proxy @FailTodos)]  newtype FailTodos = FailTodos Bool-  deriving (Typeable)  instance IsOption FailTodos where   defaultValue = FailTodos False
tasty-autocollect.cabal view
@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           tasty-autocollect-version:        0.4.3+version:        0.4.4 synopsis:       Autocollection of tasty tests. description:    Autocollection of tasty tests. See README.md for more details. category:       Testing@@ -70,22 +70,22 @@     , containers <0.8     , directory <2     , filepath <2-    , ghc >=9.4 && <9.11+    , ghc >=9.4 && <9.13     , tasty <2     , tasty-expected-failure <1-    , template-haskell >=2.19 && <2.23+    , template-haskell >=2.19 && <2.24     , text <3     , transformers <1   default-language: Haskell2010+  if impl(ghc >= 9.12) && impl(ghc < 9.14)+    other-modules:+        Test.Tasty.AutoCollect.GHC.Shim_9_12   if impl(ghc >= 9.10) && impl(ghc < 9.12)     other-modules:         Test.Tasty.AutoCollect.GHC.Shim_9_10   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  executable tasty-autocollect   main-is: Preprocessor.hs
test/Test/Tasty/AutoCollect/ConvertTestTest.hs view
@@ -1,4 +1,5 @@ {- AUTOCOLLECT.TEST -}+{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} @@ -84,13 +85,14 @@     assertAnyFailure . runTestWith (modifyFile "Test.hs" (map removeExports)) $       [ "test = testCase \"a test\" $ pure ()"       ]-  getTestLines stderr @?~ containsStripped (startsWith messagePreGHC94 `orP` startsWith messagePostGHC94)+  getTestLines stderr @?~ containsStripped (startsWith message)   where     removeExports s       | "module " `Text.isPrefixOf` s = "module Test () where"       | otherwise = s-    messagePreGHC94 = "Module ‘Test’ does not export"-    messagePostGHC94 = "NB: the module ‘Test’ does not export"+    message+      | __GLASGOW_HASKELL__ < (912 :: Int) = "NB: the module ‘Test’ does not export"+      | otherwise = "Note: The module ‘Test’ does not export"  test = testCase "test file can omit an explicit export list" $ do   (stdout, _) <-
test/TestUtils/Golden.hs view
@@ -16,10 +16,6 @@ import Test.Tasty (TestTree) import Test.Tasty.Golden -#if __GLASGOW_HASKELL__ < 904-import qualified Data.Text as Text-#endif- testGolden :: String -> FilePath -> IO Text -> TestTree testGolden name fp = goldenVsString name ("test/golden/" ++ fp) . fmap encodeText   where@@ -37,15 +33,13 @@         _ -> fp  normalizeAutocollectError :: Text -> Text-#if __GLASGOW_HASKELL__ >= 910-normalizeAutocollectError = id-#else--- GHC < 9.10 had an extra newline at the beginning. Strip this.--- GHC < 9.10 also has one fewer newline at the end. Add one.-normalizeAutocollectError = (<> "\n") . stripLeadingNewline+normalizeAutocollectError+  | __GLASGOW_HASKELL__ < (910 :: Int) =+      -- GHC < 9.10 had an extra newline at the beginning + one fewer newline at the end+      (<> "\n") . stripLeadingNewline+  | otherwise = id   where     stripLeadingNewline t =       case Text.uncons t of         Just ('\n', t') -> t'         _ -> t-#endif