ghc-lib-parser-ex 8.8.5.0 → 8.8.5.1
raw patch · 2 files changed
+119/−45 lines, 2 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ghc-lib-parser-ex.cabal +1/−1
- test/Test.hs +118/−44
ghc-lib-parser-ex.cabal view
@@ -1,6 +1,6 @@ cabal-version: >= 1.18 name: ghc-lib-parser-ex-version: 8.8.5.0+version: 8.8.5.1 description: Please see the README on GitHub at <https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme> homepage: https://github.com/shayne-fletcher/ghc-lib-parser-ex#readme bug-reports: https://github.com/shayne-fletcher/ghc-lib-parser-ex/issues
test/Test.hs view
@@ -12,6 +12,7 @@ import qualified System.FilePath as FilePath import System.IO.Extra import Control.Monad+import Data.List import Language.Haskell.GhclibParserEx.Config import Language.Haskell.GhclibParserEx.DynFlags@@ -19,15 +20,20 @@ import Language.Haskell.GhclibParserEx.Dump import Language.Haskell.GhclibParserEx.Fixity import Language.Haskell.GhclibParserEx.GHC.Hs.ExtendInstances+import Language.Haskell.GhclibParserEx.GHC.Hs.Expr #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810) import GHC.Hs import RdrHsSyn+#else+import HsSyn #endif+import SrcLoc import DynFlags import Lexer import Outputable import ErrUtils+import GHC.LanguageExtensions.Type #if defined (GHCLIB_API_808) import Bag #endif@@ -39,8 +45,19 @@ defaultMain tests tests :: TestTree-tests = testGroup " All tests" [parseTests, fixityTests, extendInstancesTests]+tests = testGroup " All tests"+ [ parseTests+ , fixityTests+ , extendInstancesTests+ , expressionPredicateTests+ ] +makeFile :: FilePath -> String -> IO FilePath+makeFile relPath contents = do+ Directory.createDirectoryIfMissing True $ FilePath.takeDirectory relPath+ writeFile relPath contents+ return relPath+ chkParseResult :: (DynFlags -> WarningMessages -> String) -> DynFlags -> ParseResult a -> IO () chkParseResult report flags = \case POk s _ -> do@@ -55,8 +72,7 @@ parseTests :: TestTree parseTests = testGroup "Parse tests"- [- testCase "Module" $+ [ testCase "Module" $ chkParseResult report flags $ parseModule (unlines [ "module Foo (readMany) where"@@ -111,12 +127,9 @@ flags = unsafeGlobalDynFlags report flags msgs = concat [ showSDoc flags msg | msg <- pprErrMsgBagWithLoc msgs ] -fixityTests :: TestTree-fixityTests = testGroup "Fixity tests"- [- testCase "Expression" $ do- let flags = defaultDynFlags fakeSettings fakeLlvmConfig- case parseExpression "1 + 2 * 3" flags of+exprTest :: String -> DynFlags -> (LHsExpr GhcPs -> IO ()) -> IO ()+exprTest s flags test =+ case parseExpression s flags of #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810) POk s e -> #else@@ -126,13 +139,22 @@ case unP (runECP_P e >>= \e -> return e) s :: ParseResult (LHsExpr GhcPs) of POk _ e -> #endif- assertBool "parse tree not affected" $- showSDocUnsafe (showAstData BlankSrcSpan e) /=- showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e))+ test e #if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)- PFailed{} -> assertFailure "ecp failure"+ _ -> assertFailure "parse error" #endif- PFailed{} -> assertFailure "parse error"+ _ -> assertFailure "parse error"++fixityTests :: TestTree+fixityTests = testGroup "Fixity tests"+ [ testCase "Expression" $ do+ let flags = defaultDynFlags fakeSettings fakeLlvmConfig+ exprTest "1 + 2 * 3" flags+ (\e ->+ assertBool "parse tree not affected" $+ showSDocUnsafe (showAstData BlankSrcSpan e) /=+ showSDocUnsafe (showAstData BlankSrcSpan (applyFixities [] e))+ ) , testCase "Pattern" $ do let flags = defaultDynFlags fakeSettings fakeLlvmConfig case parseDeclaration "f (1 : 2 :[]) = 1" flags of@@ -143,39 +165,91 @@ PFailed{} -> assertFailure "parse error" ] -makeFile :: FilePath -> String -> IO FilePath-makeFile relPath contents = do- Directory.createDirectoryIfMissing True $ FilePath.takeDirectory relPath- writeFile relPath contents- return relPath- extendInstancesTests :: TestTree extendInstancesTests = testGroup "Extend instances tests"- [- testCase "Eq, Ord" $ do+ [ testCase "Eq, Ord" $ do let flags = defaultDynFlags fakeSettings fakeLlvmConfig- case parseExpression "1 + 2 * 3" flags of-#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)- POk s e ->+ exprTest "1 + 2 * 3" flags+ (\e -> do+ e' <- return $ applyFixities [] e+ assertBool "astEq" $ astEq e e+ assertBool "astEq" $ not (astEq e e')+ e <- return $ extendInstances e+ e' <- return $ extendInstances e'+ assertBool "==" $ e == e+ assertBool "/=" $ e /= e'+ assertBool "< " $ e' < e+ assertBool ">=" $ e >= e'+ )+ ]++expressionPredicateTests :: TestTree+expressionPredicateTests = testGroup "Expression predicate tests"+ [ testCase "isTag" $ test "foo" $ assert' . isTag "foo"+ , testCase "isTag" $ test "bar" $ assert' . not . isTag "foo"+ , testCase "isDol" $ test "f $ x" $ \case L _ (OpApp _ _ op _) -> assert' $ isDol op; _ -> assertFailure "unexpected"+ , testCase "isDot" $ test "f . g" $ \case L _ (OpApp _ _ op _) -> assert' $ isDot op; _ -> assertFailure "unexpected"+ , testCase "isReturn" $ test "return x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"+ , testCase "isReturn" $ test "pure x" $ \case L _ (HsApp _ f _) -> assert' $ isReturn f; _ -> assertFailure "unexpected"+ , testCase "isSection" $ test "(1 +)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"+ , testCase "isSection" $ test "(+ 1)" $ \case L _ (HsPar _ x) -> assert' $ isSection x; _ -> assertFailure "unexpected"+ , testCase "isRecConstr" $ test "Foo {bar=1}" $ assert' . isRecConstr+ , testCase "isRecUpdate" $ test "foo {bar=1}" $ assert' . isRecUpdate+ , testCase "isVar" $ test "foo" $ assert' . isVar+ , testCase "isVar" $ test "3" $ assert' . not. isVar+ , testCase "isPar" $ test "(foo)" $ assert' . isPar+ , testCase "isPar" $ test "foo" $ assert' . not. isPar+ , testCase "isApp" $ test "f x" $ assert' . isApp+ , testCase "isApp" $ test "x" $ assert' . not . isApp+ , testCase "isOpApp" $ test "l `op` r" $ assert' . isOpApp+ , testCase "isOpApp" $ test "op l r" $ assert' . not . isOpApp+ , testCase "isAnyApp" $ test "l `op` r" $ assert' . isAnyApp+ , testCase "isAnyApp" $ test "f x" $ assert' . isAnyApp+ , testCase "isAnyApp" $ test "f x y" $ assert' . isAnyApp+ , testCase "isAnyApp" $ test "(f x y)" $ assert' . not . isAnyApp+ , testCase "isLexeme" $ test "foo" $ assert' . isLexeme+ , testCase "isLexeme" $ test "3" $ assert' . isLexeme+ , testCase "isLexeme" $ test "f x" $ assert' . not . isLexeme+ , testCase "isLambda" $ test "\\x -> 12" $ assert' . isLambda+ , testCase "isLambda" $ test "foo" $ assert' . not . isLambda+ , testCase "isDotApp" $ test "f . g" $ assert' . isDotApp+ , testCase "isDotApp" $ test "f $ g" $ assert' . not . isDotApp+ , testCase "isTypeApp" $ test "f @Int" $ assert' . isTypeApp+#if defined (GHCLIB_API_808)+ , testCase "isTypeApp" $ test "f @ Int" $ assert' . isTypeApp #else- POk _ e ->-#endif-#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)- case unP (runECP_P e >>= \e -> return e) s :: ParseResult (LHsExpr GhcPs) of- POk _ e ->-#endif- do- e' <- return $ applyFixities [] e- assertBool "astEq" $ astEq e e- assertBool "astEq" $ not (astEq e e')- e <- return $ extendInstances e- e' <- return $ extendInstances e'- assertBool "==" $ e == e- assertBool "/=" $ e /= e'- assertBool "< " $ e' < e- assertBool ">=" $ e >= e'-#if defined (GHCLIB_API_811) || defined (GHCLIB_API_810)- _ -> assertFailure "ecp failure"+ , testCase "isTypeApp" $ test "f @ Int" $ assert' . not . isTypeApp #endif- _ -> assertFailure "parse error"+ , testCase "isTypeApp" $ test "f" $ assert' . not . isTypeApp+ , testCase "isWHNF" $ test "[]" $ assert' . isWHNF+ , testCase "isWHNF" $ test "[1, 2]" $ assert' . isWHNF+ , testCase "isWHNF" $ test "'f'" $ assert' . isWHNF+ , testCase "isWHNF" $ test "foo" $ assert' . not . isWHNF+ , testCase "isWHNF" $ test "42" $ assert' . not . isWHNF+ , testCase "isWHNF" $ test "\\foo -> []" $ assert' . isWHNF+ , testCase "isWHNF" $ test "(\\foo -> [])" $ assert' . isWHNF+ , testCase "isWHNF" $ test "(\\foo -> []) x" $ assert' . not . isWHNF+ , testCase "isWHNF" $ test "(42, \"foo\")" $ assert' . isWHNF+ , testCase "isWHNF" $ test "(42, \"foo\") :: (Int, String)" $ assert' . isWHNF+ , testCase "isWHNF" $ test "(\\x -> x * x) 3 :: Int" $ assert' . not . isWHNF+ , testCase "isWHNF" $ test "Just foo" $ assert' . isWHNF+ , testCase "isWHNF" $ test "Left foo" $ assert' . isWHNF+ , testCase "isWHNF" $ test "Right foo" $ assert' . isWHNF+ , testCase "isWHNF" $ test "POk s" $ assert' . not . isWHNF+ , testCase "isLCase" $ test "\\case _ -> False" $ assert' . isLCase+ , testCase "isLCase" $ test "case x of _ -> False" $ assert' . not . isLCase+ , testCase "isSpliceDecl" $ test "$x" $ assert' . isSpliceDecl . unLoc+ , testCase "isSpliceDecl" $ test "f$x" $ assert' . not . isSpliceDecl . unLoc+ , testCase "isSpliceDecl" $ test "$(a + b)" $ assert' . isSpliceDecl . unLoc+ , testCase "isQuasiQuote" $ test "[expr|1 + 2|]" $ assert' . isQuasiQuote+ , testCase "isQuasiQuote" $ test "[expr(1 + 2)]" $ assert' . not . isQuasiQuote+ , testCase "strToVar" $ assert' . isVar . strToVar $ "foo"+ , testCase "varToStr" $ test "[]" $ assert' . (== "[]") . varToStr+ , testCase "varToStr" $ test "foo" $ assert' . (== "foo") . varToStr+ , testCase "varToStr" $ test "3" $ assert' . null . varToStr ]+ where+ assert' = assertBool ""+ test s = exprTest s flags+ flags = foldl' xopt_set (defaultDynFlags fakeSettings fakeLlvmConfig)+ [ TemplateHaskell, QuasiQuotes, TypeApplications, LambdaCase ]