Merge pull request #472 from BenFradet/parser-tests

Parser tests

parser-typechecker/src/Unison/Parser.hs

@@ -36,10 +36,8 @@ type Err v = P.ParseError (Token Input) (Error v)
 
 data Error v
   = SignatureNeedsAccompanyingBody (L.Token v)
-  -- we would include the last binding term if we didn't have to have an Ord instance for it
-  | BlockMustEndWithExpression { blockAnn :: Ann, lastBindingAnn :: Ann }
   | EmptyBlock (L.Token String)
-  | UnknownEffectConstructor (L.Token String)
+  | UnknownAbilityConstructor (L.Token String)
   | UnknownDataConstructor (L.Token String)
   | ExpectedBlockOpen String (L.Token L.Lexeme)
   | EmptyWatch

parser-typechecker/src/Unison/PrintError.hs

@@ -17,7 +17,6 @@ import           Debug.Trace
 import           Control.Lens                 ((%~))
 import           Control.Lens.Tuple           (_1, _2, _3)
 import           Control.Monad                (join)
-import qualified Data.Char                    as Char
 import           Data.Foldable
 import           Data.List                    (intersperse, sortOn)
 import qualified Data.List.NonEmpty           as Nel
@@ -953,15 +952,6 @@ prettyParseError s = \case
     , "binding after it.  Could it be a spelling mismatch?\n"
     , tokenAsErrorSite s tok
     ]
-   -- we would include the last binding term if we didn't have to have an Ord
-   -- instance for it
-  go (Parser.BlockMustEndWithExpression blockAnn lastBindingAnn) = mconcat
-    [ "The last line of the block starting at "
-    , fromString . fmap Char.toLower . annotatedToEnglish $ blockAnn
-    , "\n"
-    , "has to be an expression, not a binding/import/etc:"
-    , annotatedAsErrorSite s lastBindingAnn
-    ]
   go (Parser.EmptyBlock tok) = mconcat
     [ "I expected a block after this ("
     , describeStyle ErrorSite
@@ -971,8 +961,8 @@ prettyParseError s = \case
     ]
   go (Parser.EmptyWatch) =
     "I expected a non-empty watch expression and not just \">\""
-  go (Parser.UnknownEffectConstructor tok) = unknownConstructor "effect" tok
-  go (Parser.UnknownDataConstructor   tok) = unknownConstructor "data" tok
+  go (Parser.UnknownAbilityConstructor tok) = unknownConstructor "ability" tok
+  go (Parser.UnknownDataConstructor    tok) = unknownConstructor "data" tok
   unknownConstructor
     :: String -> L.Token String -> AnnotatedText Color
   unknownConstructor ctorType tok = mconcat

parser-typechecker/src/Unison/TermParser.hs

@@ -136,7 +136,7 @@ parsePattern = constructor <|> leaf -- similar to infixApp, but with fixed op li
     env <- ask
     (ref,cid) <- case Names.patternNameds env (L.payload name) of
       Just (ref, cid) -> pure (ref, cid)
-      Nothing -> customFailure $ UnknownEffectConstructor name
+      Nothing -> customFailure $ UnknownAbilityConstructor name
     pure $ case unzip leaves of
       (patterns, vs) ->
          (Pattern.EffectBind (ann name <> ann cont) ref cid patterns cont,

parser-typechecker/tests/Unison/Test/FileParser.hs

@@ -55,7 +55,14 @@ module Unison.Test.FileParser where
 
   test :: Test ()
   test = scope "fileparser" . tests $
-    [test1, emptyWatchTest]
+    [test1
+    , emptyWatchTest
+    , signatureNeedsAccompanyingBodyTest
+    , emptyBlockTest
+    , expectedBlockOpenTest
+    , unknownDataConstructorTest
+    , unknownAbilityConstructorTest
+    ]
 
   expectFileParseFailure :: String -> (P.Error Symbol -> Test ()) -> Test ()
   expectFileParseFailure s expectation = scope s $ do
@@ -67,7 +74,7 @@ module Unison.Test.FileParser where
           Just (MPE.ErrorCustom e) -> expectation e
           Just _ -> crash "Error encountered was not custom"
           Nothing -> crash "No error found"
-      Left _ -> crash "Parser failed with an error which was not fancy"
+      Left e -> crash ("Parser failed with an error which was a trivial parser error: " ++ show e)
 
   emptyWatchTest :: Test ()
   emptyWatchTest = scope "emptyWatchTest" $
@@ -78,6 +85,51 @@ module Unison.Test.FileParser where
           P.EmptyWatch -> ok
           _ -> crash "Error wasn't EmptyWatch"
 
+  signatureNeedsAccompanyingBodyTest :: Test ()
+  signatureNeedsAccompanyingBodyTest = scope "signatureNeedsAccompanyingBodyTest" $
+    expectFileParseFailure (unlines ["f : Nat -> Nat", "", "g a = a + 1"]) expectation
+      where
+        expectation :: Var e => P.Error e -> Test ()
+        expectation e = case e of
+          P.SignatureNeedsAccompanyingBody _ -> ok
+          _ -> crash "Error wasn't SignatureNeedsAccompanyingBody"
+
+  emptyBlockTest :: Test ()
+  emptyBlockTest = scope "emptyBlockTest" $
+    expectFileParseFailure (unlines ["f a =", "", "> 1 + 1"]) expectation
+      where
+        expectation :: Var e => P.Error e -> Test ()
+        expectation e = case e of
+          P.EmptyBlock _ -> ok
+          _ -> crash "Error wasn't EmptyBlock"
+
+  expectedBlockOpenTest :: Test ()
+  expectedBlockOpenTest = scope "expectedBlockOpenTest" $
+    expectFileParseFailure "f a b = case a b" expectation
+      where
+        expectation :: Var e => P.Error e -> Test ()
+        expectation e = case e of
+          P.ExpectedBlockOpen _ _ -> ok
+          _ -> crash "Error wasn't ExpectedBlockOpen"
+
+  unknownDataConstructorTest :: Test ()
+  unknownDataConstructorTest = scope "unknownDataConstructorTest" $
+    expectFileParseFailure "m a = case a of A -> 1" expectation
+      where
+        expectation :: Var e => P.Error e -> Test ()
+        expectation e = case e of
+          P.UnknownDataConstructor _ -> ok
+          _ -> crash "Error wasn't UnknownDataConstructor"
+
+  unknownAbilityConstructorTest :: Test ()
+  unknownAbilityConstructorTest = scope "unknownAbilityConstructorTest" $
+    expectFileParseFailure "f e = case e of {E t -> u} -> 1" expectation
+      where
+        expectation :: Var e => P.Error e -> Test ()
+        expectation e = case e of
+          P.UnknownAbilityConstructor _ -> ok
+          _ -> crash "Error wasn't UnknownAbilityConstructor"
+
   builtins :: Names
   builtins = Names.fromTerms
     [ ("Pair"     , Referent.Con (R.Builtin "Pair") 0)