mirror of
https://github.com/gren-lang/compiler.git
synced 2024-09-11 08:45:42 +03:00
Introduce some parser tests helpers. Use these on the tests for the Underscore patterns, and in particular to test we get the correct error when an Underscore **variable** is attempted to be used in an expression.
This commit is contained in:
parent
fb234fb3c6
commit
d955f899cd
@ -26,6 +26,7 @@ data BadOperator
|
||||
| BadArrow
|
||||
| BadEquals
|
||||
| BadHasType
|
||||
deriving (Show)
|
||||
|
||||
operator :: (Row -> Col -> x) -> (BadOperator -> Row -> Col -> x) -> Parser x Name.Name
|
||||
operator toExpectation toError =
|
||||
|
@ -207,6 +207,7 @@ data Expr
|
||||
| Space Space Row Col
|
||||
| IndentOperatorRight Name.Name Row Col
|
||||
| WildCard WildCard Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Record
|
||||
= RecordOpen Row Col
|
||||
@ -223,6 +224,7 @@ data Record
|
||||
| RecordIndentField Row Col
|
||||
| RecordIndentEquals Row Col
|
||||
| RecordIndentExpr Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Array
|
||||
= ArraySpace Space Row Col
|
||||
@ -233,6 +235,7 @@ data Array
|
||||
ArrayIndentOpen Row Col
|
||||
| ArrayIndentEnd Row Col
|
||||
| ArrayIndentExpr Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Func
|
||||
= FuncSpace Space Row Col
|
||||
@ -243,6 +246,7 @@ data Func
|
||||
FuncIndentArg Row Col
|
||||
| FuncIndentArrow Row Col
|
||||
| FuncIndentBody Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Case
|
||||
= CaseSpace Space Row Col
|
||||
@ -258,6 +262,7 @@ data Case
|
||||
| CaseIndentArrow Row Col
|
||||
| CaseIndentBranch Row Col
|
||||
| CasePatternAlignment Word16 Row Col
|
||||
deriving (Show)
|
||||
|
||||
data If
|
||||
= IfSpace Space Row Col
|
||||
@ -274,6 +279,7 @@ data If
|
||||
| IfIndentThenBranch Row Col
|
||||
| IfIndentElseBranch Row Col
|
||||
| IfIndentElse Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Let
|
||||
= LetSpace Space Row Col
|
||||
@ -286,6 +292,7 @@ data Let
|
||||
| LetIndentDef Row Col
|
||||
| LetIndentIn Row Col
|
||||
| LetIndentBody Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Parenthesized
|
||||
= ParenthesizedOpen Row Col
|
||||
@ -298,6 +305,7 @@ data Parenthesized
|
||||
ParenthesizedIndentOpen Row Col
|
||||
| ParenthesizedIndentEnd Row Col
|
||||
| ParenthesizedIndentExpr Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Def
|
||||
= DefSpace Space Row Col
|
||||
@ -311,6 +319,7 @@ data Def
|
||||
| DefIndentType Row Col
|
||||
| DefIndentBody Row Col
|
||||
| DefAlignment Word16 Row Col
|
||||
deriving (Show)
|
||||
|
||||
data Destruct
|
||||
= DestructSpace Space Row Col
|
||||
@ -319,6 +328,7 @@ data Destruct
|
||||
| DestructBody Expr Row Col
|
||||
| DestructIndentEquals Row Col
|
||||
| DestructIndentBody Row Col
|
||||
deriving (Show)
|
||||
|
||||
-- PATTERNS
|
||||
|
||||
@ -337,6 +347,7 @@ data Pattern
|
||||
| --
|
||||
PIndentStart Row Col
|
||||
| PIndentAlias Row Col
|
||||
deriving (Show)
|
||||
|
||||
data PParenthesized
|
||||
= PParenthesizedSpace Space Row Col
|
||||
@ -344,6 +355,7 @@ data PParenthesized
|
||||
| PParenthesizedPattern Pattern Row Col
|
||||
| PParenthesizedIndentEnd Row Col
|
||||
| PParenthesizedEnd Row Col
|
||||
deriving (Show)
|
||||
|
||||
data PRecord
|
||||
= PRecordOpen Row Col
|
||||
@ -356,6 +368,7 @@ data PRecord
|
||||
PRecordIndentOpen Row Col
|
||||
| PRecordIndentEnd Row Col
|
||||
| PRecordIndentField Row Col
|
||||
deriving (Show)
|
||||
|
||||
data PArray
|
||||
= PArrayOpen Row Col
|
||||
@ -366,6 +379,7 @@ data PArray
|
||||
PArrayIndentOpen Row Col
|
||||
| PArrayIndentEnd Row Col
|
||||
| PArrayIndentExpr Row Col
|
||||
deriving (Show)
|
||||
|
||||
-- TYPES
|
||||
|
||||
@ -377,6 +391,7 @@ data Type
|
||||
| TSpace Space Row Col
|
||||
| --
|
||||
TIndentStart Row Col
|
||||
deriving (Show)
|
||||
|
||||
data TRecord
|
||||
= TRecordOpen Row Col
|
||||
@ -393,6 +408,7 @@ data TRecord
|
||||
| TRecordIndentColon Row Col
|
||||
| TRecordIndentType Row Col
|
||||
| TRecordIndentEnd Row Col
|
||||
deriving (Show)
|
||||
|
||||
data TParenthesis
|
||||
= TParenthesisEnd Row Col
|
||||
@ -401,6 +417,7 @@ data TParenthesis
|
||||
| --
|
||||
TParenthesisIndentOpen Row Col
|
||||
| TParenthesisIndentEnd Row Col
|
||||
deriving (Show)
|
||||
|
||||
-- LITERALS
|
||||
|
||||
@ -408,26 +425,31 @@ data Char
|
||||
= CharEndless
|
||||
| CharEscape Escape
|
||||
| CharNotString Word16
|
||||
deriving (Show)
|
||||
|
||||
data String
|
||||
= StringEndless_Single
|
||||
| StringEndless_Multi
|
||||
| StringEscape Escape
|
||||
deriving (Show)
|
||||
|
||||
data Escape
|
||||
= EscapeUnknown
|
||||
| BadUnicodeFormat Word16
|
||||
| BadUnicodeCode Word16
|
||||
| BadUnicodeLength Word16 Int Int
|
||||
deriving (Show)
|
||||
|
||||
data Number
|
||||
= NumberEnd
|
||||
| NumberDot Int
|
||||
| NumberHexDigit
|
||||
| NumberNoLeadingZero
|
||||
deriving (Show)
|
||||
|
||||
data WildCard
|
||||
= WildCardAttempt Name.Name
|
||||
deriving (Show)
|
||||
|
||||
-- MISC
|
||||
|
||||
|
47
tests/Parse/Helpers.hs
Normal file
47
tests/Parse/Helpers.hs
Normal file
@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Parse.Helpers
|
||||
( checkParse
|
||||
, checkSuccessfulParse
|
||||
, checkParseError
|
||||
)
|
||||
where
|
||||
|
||||
import Data.ByteString qualified as BS
|
||||
import Parse.Space qualified as Space
|
||||
import Parse.Primitives qualified as P
|
||||
import Reporting.Annotation qualified as A
|
||||
import Test.Hspec (Spec, describe, it)
|
||||
import Test.Hspec qualified as Hspec
|
||||
|
||||
|
||||
checkParse :: (Show error, Show target) => Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (Either error (A.Located target, A.Position) -> Bool) -> BS.ByteString -> IO ()
|
||||
checkParse parser toBadEnd checkResult str =
|
||||
Hspec.shouldSatisfy
|
||||
( P.fromByteString parser toBadEnd str)
|
||||
checkResult
|
||||
|
||||
|
||||
checkSuccessfulParse :: (Show error, Show target) => Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (target -> Bool) -> BS.ByteString -> IO ()
|
||||
checkSuccessfulParse parser toBadEnd checkTarget =
|
||||
let checkResult result =
|
||||
case result of
|
||||
Right (A.At _ target, _) ->
|
||||
checkTarget target
|
||||
Left _ ->
|
||||
False
|
||||
in
|
||||
checkParse parser toBadEnd checkResult
|
||||
|
||||
checkParseError :: (Show error, Show target)=> Space.Parser error (A.Located target) -> (P.Row -> P.Col -> error) -> (error -> Bool) -> BS.ByteString -> IO ()
|
||||
checkParseError parser toBadEnd checkError =
|
||||
let checkResult result =
|
||||
case result of
|
||||
Left error ->
|
||||
checkError error
|
||||
Right _ ->
|
||||
False
|
||||
in
|
||||
checkParse parser toBadEnd checkResult
|
||||
|
||||
|
@ -4,62 +4,56 @@ module Parse.UnderscorePatternSpec where
|
||||
|
||||
import AST.Source qualified as Src
|
||||
import Data.ByteString qualified as BS
|
||||
import Data.ByteString.Internal qualified as B
|
||||
import Data.Name qualified as Name
|
||||
import Helpers.Instances ()
|
||||
import Parse.Expression qualified as Expression
|
||||
import Parse.Helpers qualified as Helpers
|
||||
import Parse.Pattern qualified as Pattern
|
||||
import Parse.Primitives qualified as P
|
||||
import Reporting.Annotation qualified as A
|
||||
import Reporting.Error.Syntax qualified as Error.Syntax
|
||||
import Test.Hspec (Spec, describe, it)
|
||||
import Test.Hspec qualified as Hspec
|
||||
|
||||
data ParseError
|
||||
= ExprError P.Row P.Col
|
||||
| OtherError String P.Row P.Col
|
||||
deriving (Show, Eq)
|
||||
|
||||
spec :: Spec
|
||||
spec = do
|
||||
describe "Wildcard patterns" $ do
|
||||
it "regression test" $
|
||||
parse "_"
|
||||
it "Newly allowed named wildcard pattern" $ do
|
||||
parse "_argument"
|
||||
it "You can have underscores as part of the lower variable which follows the underscore" $ do
|
||||
parse "_hello_world"
|
||||
it "Keywords are not allowed as the whole variable part of an underscore pattern" $ do
|
||||
parse "" "_"
|
||||
it "Newly allowed named wildcard pattern" $
|
||||
parse "argument" "_argument"
|
||||
it "You can have underscores as part of the lower variable which follows the underscore" $
|
||||
parse "hello_world" "_hello_world"
|
||||
it "Keywords are not allowed as the whole variable part of an underscore pattern" $
|
||||
failToParse "_let"
|
||||
it "But you can have a keyword as **part** of a variable name just as for normal variable names." $ do
|
||||
parse "_let_down"
|
||||
it "But you cannot start with multiple underscores" $ do
|
||||
it "But you can have a keyword as **part** of a variable name just as for normal variable names." $
|
||||
parse "let_down" "_let_down"
|
||||
it "But you cannot start with multiple underscores" $
|
||||
failToParse "__hello"
|
||||
it "But it must be an lower name, for an underscore pattern" $ do
|
||||
it "But it must be a lower name, for an underscore pattern" $
|
||||
failToParse "_Hello"
|
||||
it "We should give the specialised error when we attempt to parse _key as an expression" $
|
||||
let isWildCardAttemptError :: Error.Syntax.Expr -> Bool
|
||||
isWildCardAttemptError error =
|
||||
case error of
|
||||
Error.Syntax.WildCard (Error.Syntax.WildCardAttempt _) _ _ ->
|
||||
True
|
||||
_ ->
|
||||
False
|
||||
in Helpers.checkParseError Expression.expression Error.Syntax.Start isWildCardAttemptError "_key"
|
||||
|
||||
attemptParse :: (Either ParseError (Src.Pattern, A.Position) -> Bool) -> BS.ByteString -> IO ()
|
||||
attemptParse checkResult str =
|
||||
Hspec.shouldSatisfy
|
||||
( P.fromByteString
|
||||
(P.specialize (\_ row col -> ExprError row col) Pattern.expression)
|
||||
(OtherError "fromByteString failed")
|
||||
str
|
||||
)
|
||||
checkResult
|
||||
|
||||
parse :: BS.ByteString -> IO ()
|
||||
parse =
|
||||
let isWildCardPattern :: Either x (Src.Pattern, A.Position) -> Bool
|
||||
isWildCardPattern result =
|
||||
case result of
|
||||
Right (A.At _ (Src.PAnything _), _) -> True
|
||||
_ -> False
|
||||
in attemptParse isWildCardPattern
|
||||
parse :: String -> BS.ByteString -> IO ()
|
||||
parse expectedName =
|
||||
let isWildCardPattern :: Src.Pattern_ -> Bool
|
||||
isWildCardPattern pattern =
|
||||
case pattern of
|
||||
Src.PAnything name ->
|
||||
expectedName == (Name.toChars name)
|
||||
_ ->
|
||||
False
|
||||
in Helpers.checkSuccessfulParse Pattern.expression Error.Syntax.PStart isWildCardPattern
|
||||
|
||||
failToParse :: BS.ByteString -> IO ()
|
||||
failToParse =
|
||||
let isError :: Either x (Src.Pattern, A.Position) -> Bool
|
||||
isError result =
|
||||
case result of
|
||||
Left _ ->
|
||||
True
|
||||
_ ->
|
||||
False
|
||||
in attemptParse isError
|
||||
Helpers.checkParseError Pattern.expression Error.Syntax.PStart (\_ -> True)
|
||||
|
Loading…
Reference in New Issue
Block a user