From ae57c4fcc5b8c69b0f9932405722533843c39b0d Mon Sep 17 00:00:00 2001 From: Griffin Date: Fri, 2 Aug 2024 23:35:33 +0800 Subject: [PATCH] chore: add some test cases and rename some functions * add some test cases for newline * chore: add some test cases and rename some symbols --- src/Lib/AST/Contract.hs | 4 +- src/Lib/AST/Definition.hs | 10 +-- src/Lib/AST/Expr.hs | 9 +- src/Lib/AST/Function.hs | 17 ++-- src/Lib/AST/Model.hs | 37 +++------ src/Lib/AST/Oper.hs | 29 ++++--- src/Lib/AST/Pragma.hs | 16 ++-- src/Lib/AST/Type.hs | 5 +- src/Lib/AST/Util.hs | 16 ++-- src/Lib/Parser.hs | 1 + tests/Lib/AST/ContractSpec.hs | 2 +- tests/Lib/AST/DefinitionSpec.hs | 18 +++- tests/Lib/AST/ExprSpec.hs | 114 +++++++++++++++---------- tests/Lib/AST/FunctionSpec.hs | 142 ++++++++++++++++++++------------ tests/Lib/AST/OperSpec.hs | 24 +++--- tests/Lib/AST/StatSpec.hs | 32 +++---- tests/Lib/AST/TypeSpec.hs | 14 +++- tests/Lib/AST/UtilSpec.hs | 36 ++++++-- tests/Lib/ParserSpec.hs | 17 ++-- 19 files changed, 329 insertions(+), 214 deletions(-) diff --git a/src/Lib/AST/Contract.hs b/src/Lib/AST/Contract.hs index 4cd9c1d..164ac58 100644 --- a/src/Lib/AST/Contract.hs +++ b/src/Lib/AST/Contract.hs @@ -35,7 +35,7 @@ pContractDefinition = do >> pMany1Spaces *> pIdentifier <* pManySpaces - inheriSpeciciers <- + inherSpecifiers <- optionMaybe $ pOneKeyword "is" *> pMany1Spaces @@ -53,6 +53,6 @@ pContractDefinition = do ContractDefinition { contractName = contractName, contractIsAbstract = isJust abs, - contractInheritanceSpecifiers = fromMaybe [] inheriSpeciciers, + contractInheritanceSpecifiers = fromMaybe [] inherSpecifiers, contractBody = body } diff --git a/src/Lib/AST/Definition.hs b/src/Lib/AST/Definition.hs index c56f706..01920de 100644 --- a/src/Lib/AST/Definition.hs +++ b/src/Lib/AST/Definition.hs @@ -6,8 +6,8 @@ import Data.Either import Data.Functor (($>)) import Data.Maybe (fromMaybe, listToMaybe) import Lib.AST.Expr (pFnCallArgs) -import Lib.AST.Function (pFnDeclModifierInvocation, pFunction) -import Lib.AST.Model (ConstructorDefinition (..), ConstructorMutability (..), ContractBody (..), ContractBodyFieldSum (..), ErrorDefinition (..), ErrorParameter (ErrorParameter, errParamName, errParamType), EventDefinition (..), EventParameter (..), FnDecorator (..), FnModifierInvocation, FnName (..), Function (fname), InheritanceSpecifier (..), InterfaceDefinition (..), LibraryDefinition (..), ModifierDefinition (..), extractFnDecOs, leftCurlyBrace, leftParenthesis, rightCurlyBrace, rightParenthesis, semicolon) +import Lib.AST.Function (pFnDeclModifierInvocation, pFunctionDefinition) +import Lib.AST.Model (ConstructorDefinition (..), ConstructorMutability (..), ContractBody (..), ContractBodyFieldSum (..), ErrorDefinition (..), ErrorParameter (ErrorParameter, errParamName, errParamType), EventDefinition (..), EventParameter (..), FnDecorator (..), FnModifierInvocation, FnName (..), FunctionDefinition (fnDefName), InheritanceSpecifier (..), InterfaceDefinition (..), LibraryDefinition (..), ModifierDefinition (..), extractFnDecOs, leftCurlyBrace, leftParenthesis, rightCurlyBrace, rightParenthesis, semicolon) import Lib.AST.Pragma (pComment, pUsingDirective) import Lib.AST.Stat (pState, pStateVariable) import Lib.AST.Type (pInt, pType, pTypeEnum, pTypeStruct, pUserDefinedValueTypeDefinition) @@ -167,7 +167,7 @@ pContractBody = do ( try pComment $> CBFSSumComments <|> CBFSSumUsingDirective <$> try pUsingDirective <|> CBFSSumConstructor <$> try pConstructorDefinition - <|> CBFSSumFunction <$> try pFunction + <|> CBFSSumFunction <$> try pFunctionDefinition <|> CBFSSumModifierDefinition <$> try pModifierDefinition <|> CBFSSumStructure <$> try pTypeStruct <|> CBFSSumSTypeEnum <$> try pTypeEnum @@ -191,8 +191,8 @@ pContractBody = do ctBodyEventDefinitions = [v | CBFSSumEventDefinition v <- all], ctBodyErrorDefinitions = [v | CBFSSumErrorDefinition v <- all], ctBodyUsingDirectives = [v | CBFSSumUsingDirective v <- all], - ctBodyReceiveFunctions = filter (\f -> fname f == FnReceive) [v | CBFSSumFunction v <- all], - ctBodyFallbackFunctions = filter (\f -> fname f == FnFallback) [v | CBFSSumFunction v <- all], + ctBodyReceiveFunctions = filter (\f -> fnDefName f == FnReceive) [v | CBFSSumFunction v <- all], + ctBodyFallbackFunctions = filter (\f -> fnDefName f == FnFallback) [v | CBFSSumFunction v <- all], ctBodyAllFields = all } diff --git a/src/Lib/AST/Expr.hs b/src/Lib/AST/Expr.hs index d577bad..aebb86f 100644 --- a/src/Lib/AST/Expr.hs +++ b/src/Lib/AST/Expr.hs @@ -131,9 +131,12 @@ pUnaryExpr = do -- don't use pExpression here because we don't want to parse the whole expression after unary -- for example, -(x-1) && 234, we should parse the -(x-1) as an expression only operand <- - pParenthesizedExpr - <|> SExprL <$> pLiteral - <|> SExprVar <$> pIdentifier + pManySpaces + >> ( pParenthesizedExpr -- it's allowed to have space after the unary operator + <|> SExprL <$> pLiteral + <|> SExprVar <$> pIdentifier + <|> SExprU <$> pUnaryExpr -- double unary expression is possible, such as '- - 1' + ) return ExprUnary { uOperand = operand, diff --git a/src/Lib/AST/Function.hs b/src/Lib/AST/Function.hs index e09ffcb..4c1c2f0 100644 --- a/src/Lib/AST/Function.hs +++ b/src/Lib/AST/Function.hs @@ -30,7 +30,7 @@ import Lib.AST.Model FnName (..), FnStateMutability (..), FnVisibility (..), - Function (..), + FunctionDefinition (..), OverrideSpecifier, SType, StateVariable, @@ -52,8 +52,8 @@ import Lib.AST.Util import Lib.Parser import Text.Parsec -pFunction :: Parser Function -pFunction = do +pFunctionDefinition :: Parser FunctionDefinition +pFunctionDefinition = do name <- pManySpaces >> pOneKeyword keywordFunction @@ -61,14 +61,13 @@ pFunction = do >> pFunctionName args <- pManySpaces >> pFnDeclArgsInParentheses - -- todo: support custom modifiers as well decorators <- pFunctionDecorators - -- guards the decorators satisify the function declaration specification + -- guards the decorators satisfy the function declaration specification let visibility = extractFnDecV decorators states = extractFnDecS decorators mis = extractFnDecMI decorators - ospecifier = extractFnDecOs decorators + oSpecifier = extractFnDecOs decorators guard $ length visibility <= 1 guard $ length states <= 1 guard $ length states <= 1 @@ -86,14 +85,14 @@ pFunction = do -- why 'many anyChar' doesn't work? return - ( Function - { fname = name, + ( FunctionDefinition + { fnDefName = name, fargs = args, fnIsVirtual = FnDecVirtual `elem` decorators, fnVisibility = fromMaybe FnInternal $ listToMaybe visibility, fnState = fromMaybe FnStateDefault $ listToMaybe states, fnModifierInvocations = mis, - fnFnOverrideSpecifier = listToMaybe ospecifier, + fnFnOverrideSpecifier = listToMaybe oSpecifier, fnReturnTyp = optReturns, fnBody = fnBody } diff --git a/src/Lib/AST/Model.hs b/src/Lib/AST/Model.hs index b84577a..0975f32 100644 --- a/src/Lib/AST/Model.hs +++ b/src/Lib/AST/Model.hs @@ -56,19 +56,6 @@ leftSquareBracket = "[" rightSquareBracket :: Text rightSquareBracket = "]" -data AST - = ASTSPDXComment SPDXComment - | ASTComment Comment - | ASTPragma Pragma - | ASTType SType - | ASTFunction Function - | ASTModifier FnVisibility - | ASTVariable StateVariable - | Struct - { name :: Text - } - deriving (Show, Eq) - -- // SPDX-License-Identifier: MIT type SPDXComment = Text @@ -127,8 +114,8 @@ data FnName | FnReceive -- function receive deriving (Show, Eq) -data Function = Function - { fname :: FnName, +data FunctionDefinition = FunctionDefinition + { fnDefName :: FnName, fnState :: FnStateMutability, fnVisibility :: FnVisibility, fnModifierInvocations :: [FnModifierInvocation], @@ -314,10 +301,10 @@ data Operator | ArithmeticDivision -- / | ArithmeticModulus -- % | ArithmeticExp -- ** - | ComparisionLessEqual -- <= - | ComparisionLess -- < - | ComparisionMoreEqual -- >= - | ComparisionMore -- > + | ComparisonLessEqual -- <= + | ComparisonLess -- < + | ComparisonMoreEqual -- >= + | ComparisonMore -- > | BitAnd -- & | BitOr -- | | BitExor -- ^ @@ -327,7 +314,7 @@ data Operator | CompoundAddition -- += | CompoundMinus -- -= | CompoundMultiply -- '*=' - | CompoundDevision -- /= + | CompoundDivision -- /= | CompoundModulus -- %= | CompoundAnd -- '&=' | CompoundOr -- '|=' @@ -569,7 +556,7 @@ data InheritanceSpecifier = InheritanceSpecifier deriving (Show, Eq) data ContractBodyField - = CtFunction Function + = CtFunction FunctionDefinition | CtVariable StateVariable | CtComment Comment | CtEmptyLine @@ -577,7 +564,7 @@ data ContractBodyField data ContractBodyFieldSum = CBFSSumConstructor ConstructorDefinition - | CBFSSumFunction Function + | CBFSSumFunction FunctionDefinition | CBFSSumModifierDefinition ModifierDefinition | CBFSSumStructure Structure | CBFSSumSTypeEnum STypeEnum @@ -592,10 +579,10 @@ data ContractBodyFieldSum data ContractBody = ContractBody { ctBodyConstructor :: Maybe ConstructorDefinition, - ctBodyFunctions :: [Function], + ctBodyFunctions :: [FunctionDefinition], ctBodyModifiers :: [ModifierDefinition], - ctBodyFallbackFunctions :: [Function], - ctBodyReceiveFunctions :: [Function], + ctBodyFallbackFunctions :: [FunctionDefinition], + ctBodyReceiveFunctions :: [FunctionDefinition], ctBodyStructDefinitions :: [Structure], ctBodyEnumDefinitions :: [STypeEnum], ctBodyUserDefinedValueTypeDefinition :: [UserDefinedValueTypeDefinition], diff --git a/src/Lib/AST/Oper.hs b/src/Lib/AST/Oper.hs index 458d86d..0f6ad1b 100644 --- a/src/Lib/AST/Oper.hs +++ b/src/Lib/AST/Oper.hs @@ -31,7 +31,7 @@ pOperator2Char = do "--" -> return Decrement "**" -> return ArithmeticExp "*=" -> return CompoundMultiply - "/=" -> return CompoundDevision + "/=" -> return CompoundDivision "%=" -> return CompoundModulus "!=" -> return LogicalInequal "&&" -> return LogicalAnd @@ -39,12 +39,12 @@ pOperator2Char = do "||" -> return LogicalOr "|=" -> return CompoundOr "^=" -> return CompoundExor - "<=" -> return ComparisionLessEqual + "<=" -> return ComparisonLessEqual "<<" -> return ShiftLeft - ">=" -> return ComparisionMoreEqual + ">=" -> return ComparisonMoreEqual ">>" -> return ShiftRight "==" -> return LogicalEqual - _ -> fail "unsupport operator in two characters" + _ -> fail "un-support operator in two characters" pOperator1Char :: Parser Operator pOperator1Char = do @@ -62,9 +62,9 @@ pOperator1Char = do "~" -> return BitNeg "&" -> return BitAnd "|" -> return BitOr - "<" -> return ComparisionLess - ">" -> return ComparisionMore - _ -> fail "unsupport operator in one character" + "<" -> return ComparisonLess + ">" -> return ComparisonMore + _ -> fail "un-support operator in one character" pOperator :: Parser Operator pOperator = do @@ -74,32 +74,41 @@ pOperator = do <|> try pOperator1Char ) --- we use the same rank mentioned in the documentation to refre the precedences among different +-- we use the same rank mentioned in the documentation to refer the precedences among different -- operators, in the format of pOpRank{n} such as pOpRank1 and so on -- https://docs.soliditylang.org/en/latest/types.html#order-of-precedence-of-operators -- todo: support all the cases in rank1 -- todo: support the delete cases -- todo: think about the unary minus precedence +opRank2 :: [Operator] opRank2 = [Increment, Decrement, LogicalNegation, BitNeg] +opRank3 :: [Operator] opRank3 = [ArithmeticExp] opRank6 :: [Operator] opRank6 = [ShiftLeft, ShiftRight] +opRank7 :: [Operator] opRank7 = [BitAnd] +opRank8 :: [Operator] opRank8 = [BitExor] +opRank9 :: [Operator] opRank9 = [BitOr] -opRank10 = [ComparisionLessEqual, ComparisionLess, ComparisionMoreEqual, ComparisionMore] +opRank10 :: [Operator] +opRank10 = [ComparisonLessEqual, ComparisonLess, ComparisonMoreEqual, ComparisonMore] +opRank11 :: [Operator] opRank11 = [LogicalEqual, LogicalInequal] +opRank12 :: [Operator] opRank12 = [LogicalAnd] +opRank13 :: [Operator] opRank13 = [LogicalOr] -- todo: support op14 Ternary operator, and assignment @@ -107,7 +116,7 @@ opRank14 = [ CompoundAddition, CompoundMinus, CompoundMultiply, - CompoundDevision, + CompoundDivision, CompoundModulus, CompoundAnd, CompoundOr, diff --git a/src/Lib/AST/Pragma.hs b/src/Lib/AST/Pragma.hs index f19ad83..661e885 100644 --- a/src/Lib/AST/Pragma.hs +++ b/src/Lib/AST/Pragma.hs @@ -23,10 +23,10 @@ import Lib.AST.Model BitExor, BitNeg, BitOr, - ComparisionLess, - ComparisionLessEqual, - ComparisionMore, - ComparisionMoreEqual, + ComparisonLess, + ComparisonLessEqual, + ComparisonMore, + ComparisonMoreEqual, LogicalEqual, LogicalInequal, Minus @@ -225,10 +225,10 @@ toUserDefinableOperator o = ArithmeticMultiplication, ArithmeticDivision, ArithmeticModulus, - ComparisionLessEqual, - ComparisionLess, - ComparisionMoreEqual, - ComparisionMore, + ComparisonLessEqual, + ComparisonLess, + ComparisonMoreEqual, + ComparisonMore, BitAnd, BitOr, BitExor, diff --git a/src/Lib/AST/Type.hs b/src/Lib/AST/Type.hs index e5c69e3..504d6a6 100644 --- a/src/Lib/AST/Type.hs +++ b/src/Lib/AST/Type.hs @@ -41,6 +41,7 @@ import Lib.AST.Model UserDefinedValueTypeDefinition (..), aSize, leftCurlyBrace, + leftParenthesis, leftSquareBracket, rightSquareBracket, semicolon, @@ -96,7 +97,9 @@ pTypeMapping :: Parser Mapping pTypeMapping = do keyTyp <- pManySpaces - >> pOneKeyword "mapping(" + >> pOneKeyword "mapping" + >> pManySpaces + >> pOneKeyword leftParenthesis >> pManySpaces >> pType <* pManySpaces diff --git a/src/Lib/AST/Util.hs b/src/Lib/AST/Util.hs index 8b02dbe..8e7edfe 100644 --- a/src/Lib/AST/Util.hs +++ b/src/Lib/AST/Util.hs @@ -51,7 +51,7 @@ pFunctionArgs = ) pType (optionMaybe $ pManySpaces >> pLocationModifier) - (optionMaybe $ pManySpaces >> pIdentifier) + (optionMaybe $ pManySpaces >> pIdentifier <* pManySpaces) pStateVariableConstrain :: Parser StateVariableConstrain pStateVariableConstrain = @@ -77,15 +77,11 @@ pFnDeclVisibility = -- parse the '(name: uint)' as so on. it will consume the following spaces pFnDeclArgsInParentheses :: Parser [FnDeclArg] pFnDeclArgsInParentheses = do - fmap (fromMaybe []) $ - pManySpaces - >> pOneKeyword leftParenthesis - >> pManySpaces - >> optionMaybe pFunctionArgs - <* ( pManySpaces - >> pOneKeyword rightParenthesis - >> pManySpaces - ) + fromMaybe [] + <$> between + (pManySpaces >> pOneKeyword leftParenthesis >> pManySpaces) + (pManySpaces >> pOneKeyword rightParenthesis >> pManySpaces) + (optionMaybe pFunctionArgs) -- whether the function is decorated by the 'virtual' keyword pFnDeclVirtual :: Parser FnDecorator diff --git a/src/Lib/Parser.hs b/src/Lib/Parser.hs index 8d64c48..2d57123 100644 --- a/src/Lib/Parser.hs +++ b/src/Lib/Parser.hs @@ -47,6 +47,7 @@ pOneKeyword s = T.pack <$> string (T.unpack s) pReadline :: Parser Text pReadline = T.pack <$> manyTill anyChar (newline <|> crlf) +-- consume any Unicode space character, and the control characters \t, \n, \r, \f, \v pManySpaces :: Parser () pManySpaces = skipMany space diff --git a/tests/Lib/AST/ContractSpec.hs b/tests/Lib/AST/ContractSpec.hs index a405ef0..cbdad87 100644 --- a/tests/Lib/AST/ContractSpec.hs +++ b/tests/Lib/AST/ContractSpec.hs @@ -19,7 +19,7 @@ parseContractSpec = do let testCase = ( "contract Counter { \ \ uint256 public count;\ - \ // Function to get the current count \n \ + \ // function to get the current count \n \ \ function get() public view returns (uint256) {\ \ return count;\ \ } \ diff --git a/tests/Lib/AST/DefinitionSpec.hs b/tests/Lib/AST/DefinitionSpec.hs index ebef571..b700cc7 100644 --- a/tests/Lib/AST/DefinitionSpec.hs +++ b/tests/Lib/AST/DefinitionSpec.hs @@ -247,7 +247,23 @@ parseContractBodySpec = do \function receive(string name) public pure { count += 1; } \ \function fallback(string name) public pure { count += 1; } \ \ ", - Right 0, + resultIsRight, + "" + ), + ( "function inc(string name) public pure { count += 1; } \n\ + \modifier ExampleM(uint256 memory hello, string str); \n\ + \constructor() {} \n\ + \struct empty { \n uint128 price; \n address addr; \n } \n\ + \enum TEST { A1, a2, A3_, A_4 } \n\ + \type _Ab is address; \n\ + \uint256 constant name = hello;\n \ + \event EA(string 0 str, string) anonymous; \n\ + \event EA(string 0 str); \n\ + \using a.b.c for Bitmap;\n\ + \function receive(string name) public pure { count += 1; } \n\ + \function fallback(string name) public pure { count += 1; } \n\ + \ ", + resultIsRight, "" ) ] diff --git a/tests/Lib/AST/ExprSpec.hs b/tests/Lib/AST/ExprSpec.hs index 92f9b40..2cb4988 100644 --- a/tests/Lib/AST/ExprSpec.hs +++ b/tests/Lib/AST/ExprSpec.hs @@ -25,7 +25,7 @@ import Lib.AST.Model ExprUnary (ExprUnary, uOperand, uOperator), FnCallArgs (FnCallArgsList, FnCallArgsNamedParameters), Literal (LBool, LNum), - Operator (ArithmeticAddition, ArithmeticDivision, ArithmeticExp, ArithmeticMultiplication, BitAnd, BitExor, BitNeg, BitOr, ComparisionLess, ComparisionLessEqual, ComparisionMore, ComparisionMoreEqual, LogicalAnd, LogicalEqual, LogicalInequal, LogicalNegation, LogicalOr, Minus, ShiftLeft, ShiftRight), + Operator (ArithmeticAddition, ArithmeticDivision, ArithmeticExp, ArithmeticMultiplication, BitAnd, BitExor, BitNeg, BitOr, ComparisonLess, ComparisonLessEqual, ComparisonMore, ComparisonMoreEqual, LogicalAnd, LogicalEqual, LogicalInequal, LogicalNegation, LogicalOr, Minus, ShiftLeft, ShiftRight), SExpr (SExprB, SExprD, SExprF, SExprI, SExprL, SExprN, SExprParentheses, SExprS, SExprT, SExprU, SExprVar), ) import Lib.AST.Util @@ -34,15 +34,15 @@ import Test.Hspec (Spec) spec :: Spec spec = do - parseLogcicalExpressionSpec - parseArithemeticExpressionSpec + parseLogicalExpressionSpec + parseArithmeticExpressionSpec parseBitExpressionSpec - parseComparisionExpressionSpec + parseComparisonExpressionSpec parseShiftExpressionSpec parseUnaryExpressionSpec - parseSelectionExprSepc + parseSelectionExprSpec parseFuncCallSpec - parsepElemIndexSpec + parseElemIndexSpec parseLocationModifierSpec parseTernaryExprSpec parseDeleteNewExprSpec @@ -51,7 +51,7 @@ spec = do parsePrecedenceExprSpec :: Spec parsePrecedenceExprSpec = do let testCases = - [ ( "true?false:true || true && false == 3 < false + 3 + 2*m[1][2]**2", + [ ( "true?false:\ntrue \n|| true \n&& false == 3 < false + 3 + 2*m[1][2]**2", Right ( SExprT ExprTernary @@ -111,7 +111,7 @@ parsePrecedenceExprSpec = do }, bOperator = ArithmeticAddition }, - bOperator = ComparisionLess + bOperator = ComparisonLess }, bOperator = LogicalEqual }, @@ -123,7 +123,7 @@ parsePrecedenceExprSpec = do ), "" ), - ( "2*m[1][2]**2", + ( "2*m[1][2]\n **2", Right ( SExprB ExprBinary @@ -170,6 +170,10 @@ parseDeleteNewExprSpec = do ( "delete var", Right (SExprD "var"), "" + ), + ( "delete \nvar", + Right (SExprD "var"), + "" ) ] forM_ testCases $ exactlyParserVerifier "unary expression" pExpression @@ -186,7 +190,7 @@ parseTernaryExprSpec = do }, "" ), - ( "true ? 1*2 : 0", + ( "true ? \n1*2 : 0", Right ExprTernary { ternaryCond = SExprL (LBool True), @@ -201,7 +205,7 @@ parseTernaryExprSpec = do }, "" ), - ( "x&&y ? (1+4*5) : 0", + ( "x&&y \n? (1+4*5) : 0", Right ExprTernary { ternaryCond = @@ -230,7 +234,7 @@ parseTernaryExprSpec = do }, "" ), - ( "true ? false ? 1 :2 : 0", + ( "true ? false ? 1 :2 : \n0", Right ExprTernary { ternaryCond = SExprL (LBool True), @@ -270,9 +274,9 @@ parseLocationModifierSpec = do ] forM_ testCases $ exactlyParserVerifier "variable definition" pLocationModifier -parseSelectionExprSepc :: Spec -parseSelectionExprSepc = do - -- some test caes has an invalid syntax but still could be parsed in AST +parseSelectionExprSpec :: Spec +parseSelectionExprSpec = do + -- some test case has an invalid syntax but still could be parsed in AST let testCases = [ ( "a.b", Right $ @@ -342,6 +346,30 @@ parseUnaryExpressionSpec = do }, "" ), + ( "- 1", + Right $ + SExprU $ + ExprUnary + { uOperand = SExprL $ LNum 1, + uOperator = Minus + }, + "" + ), + ( "- - 1", + Right + ( SExprU + ExprUnary + { uOperator = Minus, + uOperand = + SExprU + ExprUnary + { uOperator = Minus, + uOperand = SExprL (LNum 1) + } + } + ), + "" + ), ( "-x", Right $ SExprU $ @@ -472,7 +500,7 @@ parseUnaryExpressionSpec = do ExprBinary { leftOperand = SExprL $ LNum 123, rightOperand = - -- this is intended, and in the syntax stage we can easily recognize such csae + -- this is intended, and in the syntax stage we can easily recognize such case SExprU $ ExprUnary { uOperand = SExprVar "x", @@ -487,7 +515,7 @@ parseUnaryExpressionSpec = do parseShiftExpressionSpec :: Spec parseShiftExpressionSpec = do - -- some test caes has an invalid syntax but still could be parsed in AST + -- some test case has an invalid syntax but still could be parsed in AST let testCases = [ ( "1 << 2", Right $ @@ -509,7 +537,7 @@ parseShiftExpressionSpec = do }, "" ), - ( "1>>2<<3", + ( "1>>2 <<3", Right ( SExprB ExprBinary @@ -526,7 +554,7 @@ parseShiftExpressionSpec = do ), "" ), - ( "1>>(2<<3)", + ( "1>> (2<<3)", Right ( SExprB ExprBinary @@ -547,9 +575,9 @@ parseShiftExpressionSpec = do ] forM_ testCases $ exactlyParserVerifier "shift expression" pExpression -parseComparisionExpressionSpec :: Spec -parseComparisionExpressionSpec = do - -- some test caes has an invalid syntax but still could be parsed in AST +parseComparisonExpressionSpec :: Spec +parseComparisonExpressionSpec = do + -- some test case has an invalid syntax but still could be parsed in AST let testCases = [ ( "1 <= 2", Right $ @@ -557,7 +585,7 @@ parseComparisionExpressionSpec = do ExprBinary { leftOperand = SExprL $ LNum 1, rightOperand = SExprL $ LNum 2, - bOperator = ComparisionLessEqual + bOperator = ComparisonLessEqual }, "" ), @@ -567,7 +595,7 @@ parseComparisionExpressionSpec = do ExprBinary { leftOperand = SExprL $ LNum 1, rightOperand = SExprL $ LNum 2, - bOperator = ComparisionLess + bOperator = ComparisonLess }, "" ), @@ -577,7 +605,7 @@ parseComparisionExpressionSpec = do ExprBinary { leftOperand = SExprL $ LNum 1, rightOperand = SExprL $ LNum 2, - bOperator = ComparisionMore + bOperator = ComparisonMore }, "" ), @@ -587,7 +615,7 @@ parseComparisionExpressionSpec = do ExprBinary { leftOperand = SExprL $ LNum 1, rightOperand = SExprL $ LNum 2, - bOperator = ComparisionMoreEqual + bOperator = ComparisonMoreEqual }, "" ), @@ -600,10 +628,10 @@ parseComparisionExpressionSpec = do ExprBinary { leftOperand = SExprL (LNum 1), rightOperand = SExprL (LNum 2), - bOperator = ComparisionMoreEqual + bOperator = ComparisonMoreEqual }, rightOperand = SExprL (LNum 3), - bOperator = ComparisionLessEqual + bOperator = ComparisonLessEqual } ), "" @@ -619,19 +647,19 @@ parseComparisionExpressionSpec = do ExprBinary { leftOperand = SExprL (LNum 2), rightOperand = SExprL (LNum 3), - bOperator = ComparisionMore + bOperator = ComparisonMore }, - bOperator = ComparisionLess + bOperator = ComparisonLess } ), "" ) ] - forM_ testCases $ exactlyParserVerifier "comparision expression" pExpression + forM_ testCases $ exactlyParserVerifier "Comparison expression" pExpression parseBitExpressionSpec :: Spec parseBitExpressionSpec = do - -- some test caes has an invalid syntax but still could be parsed in AST + -- some test case has an invalid syntax but still could be parsed in AST let testCases = [ ( "1 & 2", Right $ @@ -711,9 +739,9 @@ parseBitExpressionSpec = do ] forM_ testCases $ exactlyParserVerifier "bit expression" pExpression -parseArithemeticExpressionSpec :: Spec -parseArithemeticExpressionSpec = do - -- some test caes has an invalid syntax but still could be parsed in AST +parseArithmeticExpressionSpec :: Spec +parseArithmeticExpressionSpec = do + -- some test case has an invalid syntax but still could be parsed in AST let testCases = [ ( "1", Right $ SExprL $ LNum 1, @@ -818,9 +846,9 @@ parseArithemeticExpressionSpec = do ] forM_ testCases $ exactlyParserVerifier "arithmetic expression" pExpression -parseLogcicalExpressionSpec :: Spec -parseLogcicalExpressionSpec = do - -- some test caes has an invalid syntax but still could be parsed in AST +parseLogicalExpressionSpec :: Spec +parseLogicalExpressionSpec = do + -- some test case has an invalid syntax but still could be parsed in AST let testCases = [ ( "true", Right $ SExprL $ LBool True, @@ -973,7 +1001,7 @@ parseFuncCallSpec = do }, "" ), - ( "uint(2)", -- todo: should we seperate the type cast from function call? + ( "uint(2)", -- todo: should we separate the type cast from FunctionDefinition call? Right ExprFnCall { fnContractName = Nothing, @@ -1027,10 +1055,10 @@ parseFuncCallSpec = do "" ) ] - forM_ testCases $ exactlyParserVerifier "function call" pFuncCall + forM_ testCases $ exactlyParserVerifier "FunctionDefinition call" pFuncCall -parsepElemIndexSpec :: Spec -parsepElemIndexSpec = do +parseElemIndexSpec :: Spec +parseElemIndexSpec = do let testCases = [ ( "m[1]", Right @@ -1127,4 +1155,4 @@ parsepElemIndexSpec = do "" ) ] - forM_ testCases $ exactlyParserVerifier "index retrieveing" pElemIndex + forM_ testCases $ exactlyParserVerifier "index retrieving" pElemIndex diff --git a/tests/Lib/AST/FunctionSpec.hs b/tests/Lib/AST/FunctionSpec.hs index 604b724..f772f07 100644 --- a/tests/Lib/AST/FunctionSpec.hs +++ b/tests/Lib/AST/FunctionSpec.hs @@ -17,41 +17,69 @@ spec = do parseFunctionSignatureSpec :: Spec parseFunctionSignatureSpec = do + -- it's used to test the newline char in function definition + let fnData = + Right + FunctionDefinition + { fnReturnTyp = Nothing, + fargs = + [ FnDeclArg + { fnArgTp = STypeString, + fnArgName = Just "name", + fnArgLocation = Storage + } + ], + fnModifierInvocations = [], + fnFnOverrideSpecifier = Nothing, + fnVisibility = FnPublic, + fnState = FnStatePure, + fnIsVirtual = False, + fnDefName = FnNormal "inc", + fnBody = + Just + [ StatExpr + ( SExprB + ExprBinary + { leftOperand = SExprVar "count", + rightOperand = SExprL (LNum 1), + bOperator = CompoundAddition + } + ) + ] + } + let testCases = [ ( "function inc(string name) public pure { count += 1; }", - Right - Function - { fnReturnTyp = Nothing, - fargs = - [ FnDeclArg - { fnArgTp = STypeString, - fnArgName = Just "name", - fnArgLocation = Storage - } - ], - fnModifierInvocations = [], - fnFnOverrideSpecifier = Nothing, - fnVisibility = FnPublic, - fnState = FnStatePure, - fnIsVirtual = False, - fname = FnNormal "inc", - fnBody = - Just - [ StatExpr - ( SExprB - ExprBinary - { leftOperand = SExprVar "count", - rightOperand = SExprL (LNum 1), - bOperator = CompoundAddition - } - ) - ] - }, + fnData, + "" + ), + ( "function inc\n(string name) public pure { count += 1; }", + fnData, + "" + ), + ( "function inc\n(string name) public pure { count += 1; }", + fnData, + "" + ), + ( "function inc(string \nname) public pure { count += 1; }", + fnData, + "" + ), + ( "function inc(string name) public \npure { count += 1; }", + fnData, + "" + ), + ( "function inc(string name) public pure { \n count += 1; \n}", + fnData, + "" + ), + ( "function \ninc\n(\nstring\n name\n) \npublic\n pure\n { \n count += 1; \n}", + fnData, "" ), ( "function inc(string) public pure { count += 1; }", Right - Function + FunctionDefinition { fnReturnTyp = Nothing, fargs = [ FnDeclArg @@ -65,7 +93,7 @@ parseFunctionSignatureSpec = do fnVisibility = FnPublic, fnState = FnStatePure, fnIsVirtual = False, - fname = FnNormal "inc", + fnDefName = FnNormal "inc", fnBody = Just [ StatExpr @@ -82,7 +110,7 @@ parseFunctionSignatureSpec = do ), ( "function inc(string name, uint256 new_name) internal view returns (uint256) { count += 1; }", Right - Function + FunctionDefinition { fnReturnTyp = Just $ STypeUint 256, fargs = [ FnDeclArg @@ -101,7 +129,7 @@ parseFunctionSignatureSpec = do fnVisibility = FnInternal, fnState = FnStateView, fnIsVirtual = False, - fname = FnNormal "inc", + fnDefName = FnNormal "inc", fnBody = Just [ StatExpr @@ -118,7 +146,7 @@ parseFunctionSignatureSpec = do ), ( "function inc(string memory name, uint256 calldata new_name) internal view returns (uint256) { count += 1; }", Right - Function + FunctionDefinition { fnReturnTyp = Just $ STypeUint 256, fargs = [ FnDeclArg @@ -137,7 +165,7 @@ parseFunctionSignatureSpec = do fnVisibility = FnInternal, fnState = FnStateView, fnIsVirtual = False, - fname = FnNormal "inc", + fnDefName = FnNormal "inc", fnBody = Just [ StatExpr @@ -154,7 +182,7 @@ parseFunctionSignatureSpec = do ), ( "function inc() external payable returns (uint256) { count += 1; } }", Right - Function + FunctionDefinition { fnReturnTyp = Just $ STypeUint 256, fargs = [], fnModifierInvocations = [], @@ -162,7 +190,7 @@ parseFunctionSignatureSpec = do fnVisibility = FnExternal, fnState = FnStatePayable, fnIsVirtual = False, - fname = FnNormal "inc", + fnDefName = FnNormal "inc", fnBody = Just [ StatExpr @@ -179,7 +207,7 @@ parseFunctionSignatureSpec = do ), ( "function fallback() external payable returns (uint256);", Right - Function + FunctionDefinition { fnReturnTyp = Just $ STypeUint 256, fargs = [], fnModifierInvocations = [], @@ -187,14 +215,14 @@ parseFunctionSignatureSpec = do fnVisibility = FnExternal, fnState = FnStatePayable, fnIsVirtual = False, - fname = FnFallback, + fnDefName = FnFallback, fnBody = Nothing }, "" ), ( "function receive() external returns (uint256) { count += 1; } }", Right - Function + FunctionDefinition { fnReturnTyp = Just $ STypeUint 256, fargs = [], fnModifierInvocations = [], @@ -202,7 +230,7 @@ parseFunctionSignatureSpec = do fnVisibility = FnExternal, fnState = FnStateDefault, fnIsVirtual = False, - fname = FnReceive, + fnDefName = FnReceive, fnBody = Just [ StatExpr @@ -220,8 +248,8 @@ parseFunctionSignatureSpec = do ( -- todo: check whether it's valid if no decorator is used "function inc() virtual returns (uint256) { count += 1; } }", Right - Function - { fname = FnNormal "inc", + FunctionDefinition + { fnDefName = FnNormal "inc", fnVisibility = FnInternal, fnState = FnStateDefault, fnModifierInvocations = [], @@ -245,8 +273,8 @@ parseFunctionSignatureSpec = do ), ( "function inc() virtual modifierInvocation1 modifierInvocation1(owner) returns (uint256) ;", Right - Function - { fname = FnNormal "inc", + FunctionDefinition + { fnDefName = FnNormal "inc", fnVisibility = FnInternal, fnState = FnStateDefault, fnModifierInvocations = @@ -269,8 +297,8 @@ parseFunctionSignatureSpec = do ), ( "function inc() override returns (uint256) { count += 1; } }", Right - Function - { fname = FnNormal "inc", + FunctionDefinition + { fnDefName = FnNormal "inc", fnVisibility = FnInternal, fnState = FnStateDefault, fnModifierInvocations = [], @@ -294,8 +322,8 @@ parseFunctionSignatureSpec = do ), ( "function inc() override(a.b.c, a.b) returns (uint256) { count += 1; } }", Right - Function - { fname = FnNormal "inc", + FunctionDefinition + { fnDefName = FnNormal "inc", fnVisibility = FnInternal, fnState = FnStateDefault, fnModifierInvocations = [], @@ -319,8 +347,8 @@ parseFunctionSignatureSpec = do ), ( "function inc() virtual modifierInvocation1 override(a.b.c, a.b) modifierInvocation1(owner) returns (uint256);", Right - Function - { fname = FnNormal "inc", + FunctionDefinition + { fnDefName = FnNormal "inc", fnVisibility = FnInternal, fnState = FnStateDefault, fnModifierInvocations = @@ -342,7 +370,7 @@ parseFunctionSignatureSpec = do "" ) ] - forM_ testCases $ exactlyParserVerifier "whole function" pFunction + forM_ testCases $ exactlyParserVerifier "whole function" pFunctionDefinition parseFunctionModifiers :: Spec parseFunctionModifiers = do @@ -351,6 +379,10 @@ parseFunctionModifiers = do Right [FnDecV FnPublic, FnDecS FnStateView], "" ), + ( "public \n view ", + Right [FnDecV FnPublic, FnDecS FnStateView], + "" + ), ( "public view {", Right [FnDecV FnPublic, FnDecS FnStateView], "{" @@ -359,9 +391,17 @@ parseFunctionModifiers = do Right [FnDecV FnPublic], "{" ), + ( "public \n view \n{", + Right [FnDecV FnPublic, FnDecS FnStateView], + "{" + ), ( "public view returns {", Right [FnDecV FnPublic, FnDecS FnStateView], "returns {" + ), + ( "public \n view \nreturns \n{", + Right [FnDecV FnPublic, FnDecS FnStateView], + "returns \n{" ) ] forM_ testCases $ exactlyParserVerifier "function decorator" pFunctionDecorators diff --git a/tests/Lib/AST/OperSpec.hs b/tests/Lib/AST/OperSpec.hs index 9c2c5dd..9c8cb18 100644 --- a/tests/Lib/AST/OperSpec.hs +++ b/tests/Lib/AST/OperSpec.hs @@ -14,13 +14,13 @@ import Lib.AST.Model BitExor, BitNeg, BitOr, - ComparisionLess, - ComparisionLessEqual, - ComparisionMore, - ComparisionMoreEqual, + ComparisonLess, + ComparisonLessEqual, + ComparisonMore, + ComparisonMoreEqual, CompoundAddition, CompoundAnd, - CompoundDevision, + CompoundDivision, CompoundExor, CompoundLeftShift, CompoundMinus, @@ -100,27 +100,27 @@ parseOperatorSpec = do "" ), ( "<=", - Right ComparisionLessEqual, + Right ComparisonLessEqual, "" ), ( "<", - Right ComparisionLess, + Right ComparisonLess, "" ), ( ">=", - Right ComparisionMoreEqual, + Right ComparisonMoreEqual, "" ), ( ">=", - Right ComparisionMoreEqual, + Right ComparisonMoreEqual, "" ), ( ">", - Right ComparisionMore, + Right ComparisonMore, "" ), ( ">", - Right ComparisionMore, + Right ComparisonMore, "" ), ( "&", @@ -160,7 +160,7 @@ parseOperatorSpec = do "" ), ( "/=", - Right CompoundDevision, + Right CompoundDivision, "" ), ( "%=", diff --git a/tests/Lib/AST/StatSpec.hs b/tests/Lib/AST/StatSpec.hs index f0c2dd1..26f9e4d 100644 --- a/tests/Lib/AST/StatSpec.hs +++ b/tests/Lib/AST/StatSpec.hs @@ -247,7 +247,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -279,7 +279,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -310,7 +310,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -342,7 +342,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -379,7 +379,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -417,7 +417,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -441,7 +441,7 @@ parseStateIfElseSpec = do { selectionBase = SExprVar "msg", selectionField = "value" }, - bOperator = ComparisionMore + bOperator = ComparisonMore }, stIfThen = [ StatAssign @@ -485,7 +485,7 @@ parseStateIfElseSpec = do bOperator = ArithmeticDivision } ), - bOperator = ComparisionMore + bOperator = ComparisonMore } ), stIfThen = @@ -507,7 +507,7 @@ parseStateIfElseSpec = do rightOperand = SExprL (LNum 2), bOperator = ArithmeticDivision }, - bOperator = ComparisionMore + bOperator = ComparisonMore }, stIfThen = [ StatAssign @@ -529,7 +529,7 @@ parseStateIfElseSpec = do { selectionBase = SExprVar "msg", selectionField = "value" }, - bOperator = ComparisionMore + bOperator = ComparisonMore }, stIfThen = [ StatAssign @@ -562,7 +562,7 @@ parseStateIfElseSpec = do { selectionBase = SExprVar "msg", selectionField = "value" }, - bOperator = ComparisionMore + bOperator = ComparisonMore }, stIfThen = [ StatAssign @@ -600,7 +600,7 @@ parseForStatementSpec = do Right ( ForStatement { forDecl = Just (StVarDefStatement {stVarType = STypeInt 256, stVarName = "i", stVarLocation = Storage, stVarExpr = Just (SExprL (LNum 0)), stVarComment = Nothing}), - forExprStat = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisionLess})), + forExprStat = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisonLess})), forCond = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 1), bOperator = CompoundAddition})), forBody = [ StatAssign @@ -618,7 +618,7 @@ parseForStatementSpec = do Right ( ForStatement { forDecl = Nothing, - forExprStat = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisionLess})), + forExprStat = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisonLess})), forCond = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 1), bOperator = CompoundAddition})), forBody = [ StatAssign @@ -654,7 +654,7 @@ parseForStatementSpec = do Right ( ForStatement { forDecl = Just (StVarDefStatement {stVarType = STypeInt 256, stVarName = "i", stVarLocation = Storage, stVarExpr = Just (SExprL (LNum 0)), stVarComment = Nothing}), - forExprStat = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisionLess})), + forExprStat = Just (SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisonLess})), forCond = Nothing, forBody = [ StatAssign @@ -712,7 +712,7 @@ parseWhileStatementSpec = do ( "while(i<10){a=1;}", Right ( WhileStatement - { whileCond = SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisionLess}), + { whileCond = SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisonLess}), whileBody = [StatAssign (StAssignStatement {stAssignVarName = "a", stAssignExpr = SExprL (LNum 1)})] } ), @@ -745,7 +745,7 @@ parseDoWhileStatementSpec = do ( "do {a=1;} while(i<10);", Right ( DoWhileStatement - { doWhileCond = SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisionLess}), + { doWhileCond = SExprB (ExprBinary {leftOperand = SExprVar "i", rightOperand = SExprL (LNum 10), bOperator = ComparisonLess}), doWhileBody = [StatAssign (StAssignStatement {stAssignVarName = "a", stAssignExpr = SExprL (LNum 1)})] } ), diff --git a/tests/Lib/AST/TypeSpec.hs b/tests/Lib/AST/TypeSpec.hs index 5f09c7f..7193234 100644 --- a/tests/Lib/AST/TypeSpec.hs +++ b/tests/Lib/AST/TypeSpec.hs @@ -54,7 +54,7 @@ spec = do parseArrayMapSpec :: Spec parseArrayMapSpec = do let testCases = - [ ( "mapping(address => uint256) private _balances;", + [ ( "mapping (address => uint256) private _balances;", Right $ STypeMapping $ Mapping @@ -63,7 +63,7 @@ parseArrayMapSpec = do }, "private _balances;" ), - ( "mapping(address => mapping(address => uint256)) private _allowances;", + ( "mapping (\naddress => mapping\n(address => uint256)) \nprivate _allowances;", Right $ STypeMapping $ Mapping @@ -276,7 +276,15 @@ parseTypeEnumSpec = do }, "" ), - ( "enum TEST { A1, a2, A3_, A_4 }", + ( "enum TEST \n{ A1, a2, \nA3_, A_4 \n}", + Right $ + STypeEnum + { ename = "TEST", + eelems = ["A1", "a2", "A3_", "A_4"] + }, + "" + ), + ( "enum\n TEST \n{ A1, a2, \nA3_, A_4 \n}", Right $ STypeEnum { ename = "TEST", diff --git a/tests/Lib/AST/UtilSpec.hs b/tests/Lib/AST/UtilSpec.hs index 7cde859..88e4c97 100644 --- a/tests/Lib/AST/UtilSpec.hs +++ b/tests/Lib/AST/UtilSpec.hs @@ -14,23 +14,41 @@ spec = do parseFunctionQuotedArgs :: Spec parseFunctionQuotedArgs = do + let fnResult = + Right + [ FnDeclArg + { fnArgTp = STypeString, + fnArgName = Just "str", + fnArgLocation = Storage + } + ] let testCases = [ ( "()", Right [], "" ), + ( "(\n)", + Right [], + "" + ), ( " ( ) ", Right [], "" ), ( " (string str) ", - Right - [ FnDeclArg - { fnArgTp = STypeString, - fnArgName = Just "str", - fnArgLocation = Storage - } - ], + fnResult, + "" + ), + ( " (string \nstr) ", + fnResult, + "" + ), + ( " (\nstring str\n) ", + fnResult, + "" + ), + ( " (\nstring \nstr\n) ", + fnResult, "" ), ( " ( uint256 name) ", @@ -58,7 +76,7 @@ parseFunctionQuotedArgs = do ], "" ), - ( "(uint256 memory name, string calldata new_name, string)", + ( "(uint256 memory \nname, string calldata\n new_name, string)", Right [ FnDeclArg { fnArgTp = STypeUint 256, @@ -78,7 +96,7 @@ parseFunctionQuotedArgs = do ], "" ), - ( " ( uint256 name, string old_name, fixed256x16) ", + ( " ( uint256 name\n, string old_name,\n fixed256x16) ", Right [ FnDeclArg { fnArgTp = STypeUint 256, diff --git a/tests/Lib/ParserSpec.hs b/tests/Lib/ParserSpec.hs index dad642f..31ec629 100644 --- a/tests/Lib/ParserSpec.hs +++ b/tests/Lib/ParserSpec.hs @@ -7,11 +7,6 @@ module Lib.ParserSpec (spec) where import Control.Monad (forM_) import Lib.Parser - ( SemVer (SemVer, major, minor, patch, semVerRangeMark), - SemVerRangeMark (Tilde, Wildcards), - pSemVer, - pString, - ) import Lib.TestCommon (exactlyParserVerifier) import Test.Hspec (Spec) @@ -19,6 +14,7 @@ spec :: Spec spec = do parseVersionSpec parseStringSpec + parseManyEmptyCharsSpec parseVersionSpec :: Spec parseVersionSpec = do @@ -39,3 +35,14 @@ parseStringSpec = do ("hex\"4142434445\"", Right "ABCDE", "") ] forM_ testCases $ exactlyParserVerifier "parse string" pString + +parseManyEmptyCharsSpec :: Spec +parseManyEmptyCharsSpec = do + let testCases = + [ (" E", Right (), "E"), + (" \n E", Right (), "E"), + (" \r E", Right (), "E"), + (" \n\r E", Right (), "E"), + (" \r\n E", Right (), "E") + ] + forM_ testCases $ exactlyParserVerifier "parse empty chars" pManySpaces