1
1
mirror of https://github.com/github/semantic.git synced 2024-12-25 07:55:12 +03:00

Add a CHECK-TREE directive and simplify esoteric jq tests.

Due to the problems outlined in #245, the tests for return statements
were complicated and not testing useful properties. This patch adds a
new `CHECK-TREE` directive which lets you embed a Core expression
as a string, which is parsed and then compared against the result of
compiling the containing module.
This commit is contained in:
Patrick Thomson 2019-09-18 18:07:43 -04:00
parent 0695e85b59
commit d9f88fc046
6 changed files with 30 additions and 11 deletions

View File

@ -4,6 +4,8 @@ module Data.Core.Parser
, core , core
, lit , lit
, expr , expr
, record
, comp
, lvalue , lvalue
) where ) where

View File

@ -5,6 +5,12 @@ module Directive ( Directive (..)
) where ) where
import Control.Applicative import Control.Applicative
import Control.Monad
import Data.Name (Name)
import Data.Term (Term)
import Data.Core (Core)
import qualified Data.Core.Parser as Core.Parser
import qualified Data.Core.Pretty as Core.Pretty
import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as ByteString import qualified Data.ByteString.Char8 as ByteString
import Data.List.NonEmpty (NonEmpty) import Data.List.NonEmpty (NonEmpty)
@ -37,11 +43,13 @@ projects.
-} -}
data Directive = JQ ByteString -- | @# CHECK-JQ: expr@ data Directive = JQ ByteString -- | @# CHECK-JQ: expr@
| Tree (Term Core Name) -- | @# CHECK-TREE: core@
| Fails -- | @# CHECK-FAILS@ fails unless translation fails. | Fails -- | @# CHECK-FAILS@ fails unless translation fails.
deriving (Eq, Show) deriving (Eq, Show)
describe :: Directive -> String describe :: Directive -> String
describe Fails = "<expect failure>" describe Fails = "<expect failure>"
describe (Tree t) = Core.Pretty.showCore t
describe (JQ b) = ByteString.unpack b describe (JQ b) = ByteString.unpack b
fails :: Trifecta.Parser Directive fails :: Trifecta.Parser Directive
@ -52,8 +60,13 @@ jq = do
Trifecta.string "# CHECK-JQ: " Trifecta.string "# CHECK-JQ: "
JQ . ByteString.pack <$> many (Trifecta.noneOf "\n") JQ . ByteString.pack <$> many (Trifecta.noneOf "\n")
tree :: Trifecta.Parser Directive
tree = do
void $ Trifecta.string "# CHECK-TREE: "
Tree <$> (Core.Parser.record <|> Core.Parser.comp)
directive :: Trifecta.Parser Directive directive :: Trifecta.Parser Directive
directive = fails <|> jq directive = Trifecta.choice [ fails, jq, tree ]
toplevel :: Trifecta.Parser (NonEmpty Directive) toplevel :: Trifecta.Parser (NonEmpty Directive)
toplevel = directive `Trifecta.sepEndByNonEmpty` Trifecta.char '\n' toplevel = directive `Trifecta.sepEndByNonEmpty` Trifecta.char '\n'

View File

@ -44,6 +44,7 @@ import Analysis.ScopeGraph
import qualified Directive import qualified Directive
import Instances () import Instances ()
assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann :+: Core) Name -> HUnit.Assertion assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann :+: Core) Name -> HUnit.Assertion
assertJQExpressionSucceeds directive tree core = do assertJQExpressionSucceeds directive tree core = do
bod <- case scopeGraph Eval.eval [File interactive core] of bod <- case scopeGraph Eval.eval [File interactive core] of
@ -79,13 +80,15 @@ fixtureTestTreeForFile fp = HUnit.testCaseSteps fp $ \step -> withFrozenCallStac
let coreResult = fmap (Control.Effect.run . runFail . Py.compile @(TSP.Module TS.Span) @_ @(Term (Ann :+: Core))) result let coreResult = fmap (Control.Effect.run . runFail . Py.compile @(TSP.Module TS.Span) @_ @(Term (Ann :+: Core))) result
for_ directives $ \directive -> do for_ directives $ \directive -> do
step (Directive.describe directive) step (Directive.describe directive)
case coreResult of case (coreResult, directive) of
Left err -> HUnit.assertFailure ("Parsing failed: " <> err) (Right (Left _), Directive.Fails) -> pure ()
Right (Left _) | directive == Directive.Fails -> pure () (Left err, _) -> HUnit.assertFailure ("Parsing failed: " <> err)
Right (Right _) | directive == Directive.Fails -> HUnit.assertFailure ("Expected translation to fail") (Right (Left err), _) -> HUnit.assertFailure ("Compilation failed: " <> err)
Right (Right item) -> assertJQExpressionSucceeds directive result item (Right (Right _), Directive.Fails) -> HUnit.assertFailure ("Expected translation to fail")
Right (Left err) -> HUnit.assertFailure ("Compilation failed: " <> err) (Right (Right item), Directive.JQ _) -> assertJQExpressionSucceeds directive result item
(Right (Right item), Directive.Tree t) -> let msg = "lhs = " <> showCore t <> "\n rhs " <> showCore item'
item' = stripAnnotations item
in HUnit.assertEqual msg t item' where
milestoneFixtures :: IO Tasty.TestTree milestoneFixtures :: IO Tasty.TestTree
milestoneFixtures = do milestoneFixtures = do

View File

@ -1,2 +1,3 @@
# CHECK-JQ: .scope == {} and .tree.contents == [] # CHECK-JQ: .scope == {}
# CHECK-TREE: #record {}
() ()

View File

@ -1,3 +1,3 @@
# CHECK-JQ: .tree.contents[0][1].contents[1].contents.value.value == [] # CHECK-TREE: #record { foo : foo = (\a -> a) }
def foo(a): def foo(a):
return a return a

View File

@ -1,4 +1,4 @@
# CHECK-JQ: .tree.contents[0][1].contents[1].contents.value.value == [] # CHECK-TREE: #record { foo : foo = (\a -> a) }
def foo(a): def foo(a):
return a return a