Remove unnecessary GHC version parsing

pull/357/head
Taylor Fausak 2021-11-06 21:11:27 +00:00 committed by GitHub
parent 2ab406471b
commit 75aed1cb8a
3 changed files with 4 additions and 29 deletions

View File

@ -446,7 +446,6 @@ data Foo = Bar
deriving (Show, Eq, Monad, Functor, Traversable, Foldable) deriving (Show, Eq, Monad, Functor, Traversable, Foldable)
#test record multiple deriving strategies #test record multiple deriving strategies
#min-ghc 8.2
data Foo = Bar data Foo = Bar
{ foo :: Baz { foo :: Baz
, bars :: Bizzz , bars :: Bizzz
@ -461,7 +460,6 @@ data Foo = Bar
deriving newtype (Traversable, Foldable) deriving newtype (Traversable, Foldable)
#test record deriving via #test record deriving via
#min-ghc 8.6
data Foo = Bar data Foo = Bar
{ foo :: Baz { foo :: Baz
, bars :: Bizzz , bars :: Bizzz
@ -535,7 +533,6 @@ data Foo = Bar
## maybe we want to switch to a differnt layout when there are such comments. ## maybe we want to switch to a differnt layout when there are such comments.
## Don't hesitate to modify this testcase, it clearly is not the ideal layout ## Don't hesitate to modify this testcase, it clearly is not the ideal layout
## for this. ## for this.
#min-ghc 8.6
data Foo = Bar data Foo = Bar
{ foo :: Baz { foo :: Baz

View File

@ -152,7 +152,6 @@ pattern Signed x <- (asSigned -> x) where
Signed (Pos x) = x -- positive comment Signed (Pos x) = x -- positive comment
#test Pattern synonym types multiple names #test Pattern synonym types multiple names
#min-ghc 8.2
{-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE PatternSynonyms #-}
pattern J, K :: a -> Maybe a pattern J, K :: a -> Maybe a

View File

@ -1,9 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonadComprehensions #-} {-# LANGUAGE MonadComprehensions #-}
import Language.Haskell.Brittany.Internal.Prelude import Language.Haskell.Brittany.Internal.Prelude
import qualified Data.List.Extra
import qualified Data.Maybe import qualified Data.Maybe
import qualified Data.Semigroup as Semigroup import qualified Data.Semigroup as Semigroup
import qualified Data.Text as Text import qualified Data.Text as Text
@ -32,7 +30,6 @@ import System.FilePath ( (</>) )
data InputLine data InputLine
= GroupLine Text = GroupLine Text
| HeaderLine Text | HeaderLine Text
| GhcVersionGuardLine Text
| PendingLine | PendingLine
| NormalLine Text | NormalLine Text
| CommentLine | CommentLine
@ -41,7 +38,6 @@ data InputLine
data TestCase = TestCase data TestCase = TestCase
{ testName :: Text { testName :: Text
, isPending :: Bool , isPending :: Bool
, minGHCVersion :: Maybe Text
, content :: Text , content :: Text
} }
@ -56,26 +52,17 @@ main = do
let groups = createChunks =<< inputs let groups = createChunks =<< inputs
inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt" inputCtxFree <- Text.IO.readFile "src-literatetests/30-tests-context-free.blt"
let groupsCtxFree = createChunks inputCtxFree let groupsCtxFree = createChunks inputCtxFree
let parseVersion :: Text -> Maybe [Int]
parseVersion =
mapM (readMaybe . Text.unpack) . Text.splitOn (Text.pack ".")
let ghcVersion = Data.Maybe.fromJust $ parseVersion $ Text.pack VERSION_ghc
let checkVersion = \case
Nothing -> True -- no version constraint
Just s -> case parseVersion s of
Nothing -> error $ "could not parse version " ++ Text.unpack s
Just v -> v <= ghcVersion
hspec $ do hspec $ do
groups `forM_` \(groupname, tests) -> do groups `forM_` \(groupname, tests) -> do
describe (Text.unpack groupname) $ do describe (Text.unpack groupname) $ do
tests `forM_` \test -> when (checkVersion $ minGHCVersion test) $ do tests `forM_` \test -> do
(if isPending test then before_ pending else id) (if isPending test then before_ pending else id)
$ it (Text.unpack $ testName test) $ it (Text.unpack $ testName test)
$ roundTripEqual defaultTestConfig $ roundTripEqual defaultTestConfig
$ content test $ content test
groupsCtxFree `forM_` \(groupname, tests) -> do groupsCtxFree `forM_` \(groupname, tests) -> do
describe ("context free: " ++ Text.unpack groupname) $ do describe ("context free: " ++ Text.unpack groupname) $ do
tests `forM_` \test -> when (checkVersion $ minGHCVersion test) $ do tests `forM_` \test -> do
(if isPending test then before_ pending else id) (if isPending test then before_ pending else id)
$ it (Text.unpack $ testName test) $ it (Text.unpack $ testName test)
$ roundTripEqual contextFreeTestConfig $ roundTripEqual contextFreeTestConfig
@ -113,15 +100,12 @@ main = do
in TestCase in TestCase
{ testName = n { testName = n
, isPending = any isPendingLine rest , isPending = any isPendingLine rest
, minGHCVersion = Data.List.Extra.firstJust extractMinGhc rest
, content = Text.unlines normalLines , content = Text.unlines normalLines
} }
l -> l ->
error $ "first non-empty line must start with #test footest\n" ++ show l error $ "first non-empty line must start with #test footest\n" ++ show l
extractNormal (NormalLine l) = Just l extractNormal (NormalLine l) = Just l
extractNormal _ = Nothing extractNormal _ = Nothing
extractMinGhc (GhcVersionGuardLine v) = Just v
extractMinGhc _ = Nothing
isPendingLine PendingLine{} = True isPendingLine PendingLine{} = True
isPendingLine _ = False isPendingLine _ = False
specialLineParser :: Parser InputLine specialLineParser :: Parser InputLine
@ -138,11 +122,6 @@ main = do
, name <- Parsec.many1 $ Parsec.noneOf "\r\n:" , name <- Parsec.many1 $ Parsec.noneOf "\r\n:"
, _ <- Parsec.eof , _ <- Parsec.eof
] ]
, [ GhcVersionGuardLine $ Text.pack version
| _ <- Parsec.try $ Parsec.string "#min-ghc"
, _ <- Parsec.many1 $ Parsec.oneOf " \t"
, version <- Parsec.many1 $ Parsec.noneOf "\r\n:"
]
, [ PendingLine , [ PendingLine
| _ <- Parsec.try $ Parsec.string "#pending" | _ <- Parsec.try $ Parsec.string "#pending"
, _ <- Parsec.optional $ many (Parsec.noneOf "\r\n") , _ <- Parsec.optional $ many (Parsec.noneOf "\r\n")