Remove unnecessary GHC version parsing
parent
2ab406471b
commit
75aed1cb8a
|
@ -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
|
||||||
|
|
|
@ -121,7 +121,7 @@ pattern myLeftVariableName `MyInfixPatternMatcher` myRightVariableName <-
|
||||||
[myLongLeftVariableName, myLongRightVariableName] where
|
[myLongLeftVariableName, myLongRightVariableName] where
|
||||||
MyInfixPatternMatcher x y = [x, x, y]
|
MyInfixPatternMatcher x y = [x, x, y]
|
||||||
|
|
||||||
#test Pattern synonym types
|
#test Pattern synonym types
|
||||||
{-# LANGUAGE PatternSynonyms #-}
|
{-# LANGUAGE PatternSynonyms #-}
|
||||||
pattern J :: a -> Maybe a
|
pattern J :: a -> Maybe a
|
||||||
pattern J x = Just x
|
pattern J x = Just x
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
@ -239,4 +238,4 @@ foo = let ?bar = Foo in value
|
||||||
#test IP type signature
|
#test IP type signature
|
||||||
{-# LANGUAGE ImplicitParams #-}
|
{-# LANGUAGE ImplicitParams #-}
|
||||||
foo :: (?bar::Bool) => ()
|
foo :: (?bar::Bool) => ()
|
||||||
foo = ()
|
foo = ()
|
||||||
|
|
|
@ -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")
|
||||||
|
|
Loading…
Reference in New Issue