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.

semantic-core/src/Data/Core/Parser.hs

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

semantic-python/test/Directive.hs

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

semantic-python/test/Test.hs

@@ -44,6 +44,7 @@ import           Analysis.ScopeGraph
 import qualified Directive
 import           Instances ()
 
+
 assertJQExpressionSucceeds :: Show a => Directive.Directive -> a -> Term (Ann :+: Core) Name -> HUnit.Assertion
 assertJQExpressionSucceeds directive tree core = do
   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
   for_ directives $ \directive -> do
     step (Directive.describe directive)
-    case coreResult of
-      Left err           -> HUnit.assertFailure ("Parsing failed: " <> err)
-      Right (Left _)     | directive == Directive.Fails -> pure ()
-      Right (Right _)    | directive == Directive.Fails -> HUnit.assertFailure ("Expected translation to fail")
-      Right (Right item) -> assertJQExpressionSucceeds directive result item
-      Right (Left err)   -> HUnit.assertFailure ("Compilation failed: " <> err)
-
+    case (coreResult, directive) of
+      (Right (Left _), Directive.Fails)      -> pure ()
+      (Left err, _)                          -> HUnit.assertFailure ("Parsing failed: " <> err)
+      (Right (Left err), _)                  -> HUnit.assertFailure ("Compilation failed: " <> err)
+      (Right (Right _), Directive.Fails)     -> HUnit.assertFailure ("Expected translation to fail")
+      (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 = do

semantic-python/test/fixtures/1-03-empty-tuple.py

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

semantic-python/test/fixtures/2-01-return-statement.py

@@ -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):
     return a

semantic-python/test/fixtures/2-02-return-doesnt-translate.py

@@ -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):
     return a