From 919cddd81470bfdbfa46451cde17dfc983bd9173 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bart=C5=82omiej=20Przemys=C5=82aw=20Pluta?= Date: Fri, 5 Nov 2021 17:27:56 +0100 Subject: [PATCH] Add unit tests for Assembler parsers --- MVM.cabal | 3 +- app/Assembler/Parser.hs | 9 +- test/Assembler/ParserSpec.hs | 541 ++++++++++++++++++++++++++++++++ test/Assembler/TokenizerSpec.hs | 6 +- 4 files changed, 552 insertions(+), 7 deletions(-) create mode 100644 test/Assembler/ParserSpec.hs diff --git a/MVM.cabal b/MVM.cabal index 995415e..33af7de 100644 --- a/MVM.cabal +++ b/MVM.cabal @@ -24,7 +24,7 @@ executable MVM main-is: Main.hs ghc-options: -Wall - + -- Modules included in this executable, other than Main. other-modules: VirtualMachine @@ -56,6 +56,7 @@ test-suite spec , hspec ==2.* other-modules: Assembler.TokenizerSpec + Assembler.ParserSpec VirtualMachine Assembler.Tokenizer diff --git a/app/Assembler/Parser.hs b/app/Assembler/Parser.hs index c0bdbf2..a4ecc7f 100644 --- a/app/Assembler/Parser.hs +++ b/app/Assembler/Parser.hs @@ -1,7 +1,4 @@ -module Assembler.Parser ( - AST, - parse -) where +module Assembler.Parser where import qualified Data.List as List import qualified Data.Monoid as Monoid @@ -77,6 +74,7 @@ parseLine :: Parser parseLine = parseSeq [parseOptionally parseLabelDef, parseOptionally parseInstr] (\[label, instr] -> Line label instr) mapAST :: Parser -> (AST -> AST) -> Parser +mapAST _ _ [] = Nothing mapAST parser mapper tokens = do (ParseResult ast consumed) <- parser tokens return $ ParseResult (mapper ast) consumed @@ -116,10 +114,12 @@ parseAlt parsers mapper tokens = do -- a | b | c parseAny :: [Parser] -> Parser +parseAny _ [] = Nothing parseAny parsers tokens = Monoid.getFirst . Monoid.mconcat . map Monoid.First $ sequenceA parsers tokens -- a b c parseSeq :: [Parser] -> ([AST] -> AST) -> Parser +parseSeq _ _ [] = Nothing parseSeq parsers combiner tokens = do results <- parseAll parsers tokens let consumed = sum $ map (\(ParseResult _ c) -> c) results @@ -138,6 +138,7 @@ parseAll (p:ps) tokens = do -- 'Nothing' if not consumed tokens exist assertConsumed :: Parser -> Parser +assertConsumed _ [] = Nothing assertConsumed parser tokens = do r@(ParseResult _ consumed) <- parser tokens if null (drop consumed tokens) diff --git a/test/Assembler/ParserSpec.hs b/test/Assembler/ParserSpec.hs new file mode 100644 index 0000000..a5fd36d --- /dev/null +++ b/test/Assembler/ParserSpec.hs @@ -0,0 +1,541 @@ +module Assembler.ParserSpec where + +import Test.Hspec +import Test.Hspec.QuickCheck + +import qualified Assembler.Tokenizer as T +import Assembler.Parser +import VirtualMachine + +success :: AST -> Int -> Maybe ParseResult +success ast consumed = Just $ ParseResult ast consumed + +spec :: Spec +spec = do + describe "parseOperator" $ do + it "accepts operator tokens" $ do + let ops = [Nop ..] + let input = map ((:[]) . T.Operator) ops + let expected = map (flip success 1 . Operator) ops + map parseOperator input `shouldBe` expected + it "supports non-truncated input" $ do + parseOperator [T.Operator Call, T.Ampersand, T.Identifier "label"] `shouldBe` success (Operator Call) 1 + it "supports empty input" $ + parseOperator [] `shouldBe` Nothing + + describe "parseInt" $ do + it "accepts int literal tokens" $ do + let ints = [-65535, -65534 .. 65535] + let input = map ((:[]) . T.IntLiteral) ints + let expected = map (flip success 1 . Integer) ints + map parseInt input `shouldBe` expected + it "supports non-truncated input" $ do + parseInt [T.IntLiteral 4, T.Colon] `shouldBe` success (Integer 4) 1 + it "supports empty input" $ + parseInt [] `shouldBe` Nothing + + describe "parseIdentifier" $ do + it "accepts identifier tokens" $ + parseIdentifier [T.Identifier "someId"] `shouldBe` success (Identifier "someId") 1 + it "supports non-truncated input" $ do + parseIdentifier [T.Identifier "label", T.Colon] `shouldBe` success (Identifier "label") 1 + it "supports empty input" $ + parseIdentifier [] `shouldBe` Nothing + + describe "parseColon" $ do + it "accepts colon tokens" $ + parseColon [T.Colon] `shouldBe` success Colon 1 + it "supports non-truncated input" $ do + parseColon [T.Colon, T.Operator Add] `shouldBe` success Colon 1 + it "supports empty input" $ + parseColon [] `shouldBe` Nothing + + describe "parseAmpersand" $ do + it "accepts colon tokens" $ + parseAmpersand [T.Ampersand] `shouldBe` success Ampersand 1 + it "supports non-truncated input" $ do + parseAmpersand [T.Ampersand, T.Identifier "label"] `shouldBe` success Ampersand 1 + it "supports empty input" $ + parseAmpersand [] `shouldBe` Nothing + + describe "parseLabelDef" $ do + it "parses 'label:'" $ + parseLabelDef [T.Identifier "label", T.Colon] `shouldBe` success (LabelDef "label") 2 + it "requires label" $ + parseLabelDef [T.Colon] `shouldBe` Nothing + it "requires colon" $ + parseLabelDef [T.Identifier "label"] `shouldBe` Nothing + it "supports non-truncated input" $ do + parseLabelDef [T.Identifier "sum", T.Colon, T.Operator Nop] `shouldBe` success (LabelDef "sum") 2 + it "supports empty input" $ + parseLabelDef [] `shouldBe` Nothing + + describe "parseLabelRef" $ do + it "parses '&label'" $ + parseLabelRef [T.Ampersand, T.Identifier "label"] `shouldBe` success (LabelRef "label") 2 + it "requires label" $ + parseLabelRef [T.Ampersand] `shouldBe` Nothing + it "requires ampersand" $ + parseLabelRef [T.Identifier "label"] `shouldBe` Nothing + it "supports non-truncated input" $ do + parseLabelRef [T.Ampersand, T.Identifier "sum", T.Operator Nop] `shouldBe` success (LabelRef "sum") 2 + it "supports empty input" $ + parseLabelRef [] `shouldBe` Nothing + + describe "parseParam" $ do + it "parses int params" $ do + let ints = [-65535, -65534 .. 65535] + let input = map ((:[]) . T.IntLiteral) ints + let expected = map (flip success 1 . Param . Integer) ints + map parseParam input `shouldBe` expected + it "parses label references" $ do + let expected = success (Param (LabelRef "program")) 2 + parseParam [T.Ampersand, T.Identifier "program"] `shouldBe` expected + it "supports non-truncated input" $ do + let expected = success (Param (Integer 1)) 1 + parseParam [T.IntLiteral 1, T.IntLiteral 2, T.IntLiteral 3] `shouldBe` expected + it "supports empty input" $ + parseParam [] `shouldBe` Nothing + + describe "parseInstr" $ do + it "parses no-param operator" $ do + let input = [T.Operator Halt] + let expected = success (Instruction + (Operator Halt) + Empty + ) (length input) + parseInstr input `shouldBe` expected + it "parses operator with single int param" $ do + let input = [T.Operator Push, T.IntLiteral 4] + let expected = success (Instruction + (Operator Push) + (Params [ + (Param (Integer 4)) + ]) + ) (length input) + parseInstr input `shouldBe` expected + it "parses operator with single label ref param" $ do + let input = [T.Operator Call, T.Ampersand, T.Identifier "program"] + let expected = success (Instruction + (Operator Call) + (Params [ + (Param (LabelRef "program")) + ]) + ) (length input) + parseInstr input `shouldBe` expected + it "parses operator with multiple int params" $ do + let input = [T.Operator Push + , T.IntLiteral 1 + , T.IntLiteral 4 + , T.IntLiteral 2 + , T.IntLiteral 0 + ] + let expected = success (Instruction + (Operator Push) + (Params [ + (Param (Integer 1)), + (Param (Integer 4)), + (Param (Integer 2)), + (Param (Integer 0)) + ]) + ) (length input) + parseInstr input `shouldBe` expected + it "parses operator with multiple param ref params" $ do + let input = [T.Operator Push + , T.Ampersand, T.Identifier "program" + , T.Ampersand, T.Identifier "main" + , T.Ampersand, T.Identifier "foo" + , T.Ampersand, T.Identifier "bar" + ] + let expected = success (Instruction + (Operator Push) + (Params [ + (Param (LabelRef "program")), + (Param (LabelRef "main")), + (Param (LabelRef "foo")), + (Param (LabelRef "bar")) + ]) + ) (length input) + parseInstr input `shouldBe` expected + it "parses operator with multiple mixed params" $ do + let input = [T.Operator Push + , T.Ampersand, T.Identifier "program" + , T.IntLiteral 4 + , T.Ampersand, T.Identifier "main" + , T.Ampersand, T.Identifier "foo" + , T.IntLiteral 10 + , T.IntLiteral 11 + , T.Ampersand, T.Identifier "bar" + , T.IntLiteral 20 + ] + let expected = success (Instruction + (Operator Push) + (Params [ + (Param (LabelRef "program")), + (Param (Integer 4)), + (Param (LabelRef "main")), + (Param (LabelRef "foo")), + (Param (Integer 10)), + (Param (Integer 11)), + (Param (LabelRef "bar")), + (Param (Integer 20)) + ]) + ) (length input) + parseInstr input `shouldBe` expected + it "supports non-truncated input" $ do + let input = [T.Operator Push + , T.Ampersand, T.Identifier "program" + , T.IntLiteral 4 + , T.Ampersand, T.Identifier "main" + , T.Ampersand, T.Identifier "foo" + , T.IntLiteral 10 + , T.IntLiteral 11 + , T.Ampersand, T.Identifier "bar" + , T.IntLiteral 20 -- this is the last param, so we're going to stop here (13 tokens so far) + , T.Operator Call + , T.Ampersand, T.Identifier "program" + ] + let expected = success (Instruction + (Operator Push) + (Params [ + (Param (LabelRef "program")), + (Param (Integer 4)), + (Param (LabelRef "main")), + (Param (LabelRef "foo")), + (Param (Integer 10)), + (Param (Integer 11)), + (Param (LabelRef "bar")), + (Param (Integer 20)) + ]) + ) 13 + parseInstr input `shouldBe` expected + it "supports empty input" $ + parseInstr [] `shouldBe` Nothing + + describe "parseLine" $ do + it "supports label definition and operator in the same line" $ do + let input = [T.Identifier "main", T.Colon, T.Operator Call, T.Ampersand, T.Identifier "program"] + let expected = success (Line + (LabelDef "main") + (Instruction + (Operator Call) + (Params [ + (Param (LabelRef "program")) + ]) + ) + ) (length input) + parseLine input `shouldBe` expected + it "supports line with just label definition" $ do + let input = [T.Identifier "main", T.Colon] + let expected = success (Line + (LabelDef "main") + Empty + ) (length input) + parseLine input `shouldBe` expected + it "supports line with just operator" $ do + let input = [T.Operator Call, T.Ampersand, T.Identifier "program"] + let expected = success (Line + Empty + (Instruction + (Operator Call) + (Params [ + (Param (LabelRef "program")) + ]) + ) + ) (length input) + parseLine input `shouldBe` expected + it "supports non-truncated input" $ do + let input = [T.Identifier "main", T.Colon, T.Operator Call, T.Ampersand, T.Identifier "program", T.Identifier "exit"] + let expected = success (Line + (LabelDef "main") + (Instruction + (Operator Call) + (Params [ + (Param (LabelRef "program")) + ]) + ) + ) 5 + parseLine input `shouldBe` expected + it "parses empty input" $ + parseLine [] `shouldBe` Nothing + + describe "mapAST" $ do + it "returns mapped AST if wrapped parser succeeded" $ do + let astMapper ast = Param ast + let parser = const $ success Colon 1 + let input = [T.StringLiteral "Some not important input"] + mapAST parser astMapper input `shouldBe` success (Param Colon) 1 + it "results Nothing when wrapped parser failed" $ do + let astMapper ast = Param ast + let parser = const Nothing + let input = [T.StringLiteral "Some not important input"] + mapAST parser astMapper input `shouldBe` Nothing + it "supports empty input irrespective of wrapped parser" $ do + let astMapper ast = Param ast + let parser = const $ success Colon 1 + let input = [] + mapAST parser astMapper input `shouldBe` Nothing + + describe "parseOptionally" $ do + it "returns parsed AST if wrapped parser succeeded" $ do + let parser = const $ success Ampersand 1 + let input = [T.StringLiteral "Some not important input"] + parseOptionally parser input `shouldBe` success Ampersand 1 + it "returns Empty if wrapped parser failed" $ do + let parser = const $ Nothing + let input = [T.StringLiteral "Some not important input"] + parseOptionally parser input `shouldBe` success Empty 0 + it "supports empty input irrespective of wrapped parser" $ do + let parser = const $ Nothing + let input = [] + parseOptionally parser input `shouldBe` success Empty 0 + + describe "parseMany" $ do + it "parses many occurrences on truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon, T.Colon, T.Colon] + parseMany colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3 + it "parses single occurence on truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon] + parseMany colonParser combiner input `shouldBe` success (Params [Colon]) 1 + it "parses many occurrences on non-truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon, T.Colon, T.Colon, T.Ampersand] + parseMany colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3 + it "parses single occurence on non-truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon, T.Ampersand] + parseMany colonParser combiner input `shouldBe` success (Params [Colon]) 1 + it "rejects input if current token is not parseable" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Ampersand, T.Colon, T.Colon, T.Colon] + parseMany colonParser combiner input `shouldBe` Nothing + it "supports empty input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [] + parseMany colonParser combiner input `shouldBe` Nothing + + describe "parseMany0" $ do + it "parses many occurrences on truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon, T.Colon, T.Colon] + parseMany0 colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3 + it "parses single occurence on truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon] + parseMany0 colonParser combiner input `shouldBe` success (Params [Colon]) 1 + it "parses many occurrences on non-truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon, T.Colon, T.Colon, T.Ampersand] + parseMany0 colonParser combiner input `shouldBe` success (Params [Colon, Colon, Colon]) 3 + it "parses single occurence on non-truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Colon, T.Ampersand] + parseMany0 colonParser combiner input `shouldBe` success (Params [Colon]) 1 + it "accepts input even though current token is not parseable" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [T.Ampersand, T.Colon, T.Colon, T.Colon] + parseMany0 colonParser combiner input `shouldBe` success Empty 0 + it "supports empty input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let combiner = Params + let input = [] + parseMany0 colonParser combiner input `shouldBe` success Empty 0 + + describe "parseAny" $ do + it "returns the AST if at least one subparser produce that" $ do + let parsers = map const [ success Ampersand 1 + , Nothing + , Nothing + , Nothing + , Nothing + ] + let input = [T.StringLiteral "some not important input"] + parseAny parsers input `shouldBe` success Ampersand 1 + it "returns the AST of the first matching subparser" $ do + let parsers = map const [ Nothing + , Nothing + , success (Integer 4) 1 + , Nothing + , Nothing + , success (LabelDef "not me") 2 + , Nothing + , success (Instruction (Operator Push) Empty) 1 + , Nothing + , success Ampersand 1 + , Nothing + , Nothing + , success Colon 1 + , Nothing + ] + let input = [T.StringLiteral "some not important input"] + parseAny parsers input `shouldBe` success (Integer 4) 1 + it "returns Nothing if no one of the parsers matches the input" $ do + let parsers = map const (take 4 $ repeat $ Nothing) + let input = [T.StringLiteral "some not important input"] + parseAny parsers input `shouldBe` Nothing + it "always returns Nothing if no parsers are defined" $ do + let input = [T.StringLiteral "some not important input"] + parseAny [] input `shouldBe` Nothing + it "supports empty input irrespective of wrapped parsers" $ do + let parsers = map const [ success (Integer 4) 1 + , success (LabelDef "not me") 2 + , success (Instruction (Operator Push) Empty) 1 + , Nothing + , success Ampersand 1 + , success Colon 1 + ] + let input = [] + parseAny parsers input `shouldBe` Nothing + + describe "parseSeq" $ do + it "parses truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let ampersandParser (T.Ampersand:_) = success Ampersand 1 + ampersandParser _ = Nothing + let combiner = Params + let pattern = [colonParser, ampersandParser] + let input = [T.Colon, T.Ampersand] + parseSeq pattern combiner input `shouldBe` success (Params [Colon, Ampersand]) 2 + it "parses non-truncated input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let ampersandParser (T.Ampersand:_) = success Ampersand 1 + ampersandParser _ = Nothing + let combiner = Params + let pattern = [colonParser, ampersandParser] + let input = [T.Colon, T.Ampersand, T.Colon] + parseSeq pattern combiner input `shouldBe` success (Params [Colon, Ampersand]) 2 + it "rejects incomplete pattern" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let ampersandParser (T.Ampersand:_) = success Ampersand 1 + ampersandParser _ = Nothing + let combiner = Params + let pattern = [colonParser, ampersandParser] + let input = [T.Colon] + parseSeq pattern combiner input `shouldBe` Nothing + it "rejects non-matching input" $ do + let colonParser (T.Colon:_) = success Colon 1 + colonParser _ = Nothing + let ampersandParser (T.Ampersand:_) = success Ampersand 1 + ampersandParser _ = Nothing + let combiner = Params + let pattern = [colonParser, ampersandParser] + let input = [T.Ampersand, T.Colon] + parseSeq pattern combiner input `shouldBe` Nothing + it "supports empty input irrespective of wrapped parsers" $ do + let pattern = map const [ success (Integer 4) 1 + , success (LabelDef "not me") 2 + , success (Instruction (Operator Push) Empty) 1 + , success Ampersand 1 + , success Colon 1 + ] + let combiner = Params + let input = [] + parseSeq pattern combiner input `shouldBe` Nothing + + describe "assertConsumed" $ do + it "returns AST if no tokens are left to be consumed" $ do + let parser = const $ success Colon 1 + let input = [T.Colon] + assertConsumed parser input `shouldBe` success Colon 1 + it "returns Nothing if there are tokens left to be consumed, even though the wrapped parser succeeded to parse" $ do + let parser = const $ success Colon 1 + let input = [T.Colon, T.Ampersand] + assertConsumed parser input `shouldBe` Nothing + it "supports empty input" $ do + let parser = const $ success Colon 1 + let input = [] + assertConsumed parser input `shouldBe` Nothing + + describe "parse" $ do + it "parses empty input" $ do + let input = "" + let (Right tokens) = T.tokenize input + parse tokens `shouldBe` (Right $ Program [] :: Either String AST) + it "parses line by line" $ do + let input = "add1_2: push 1\npush 2\nadd" + let (Right tokens) = T.tokenize input + -- Labels: Operations: Params: + let expected = Program [ (Line (LabelDef "add1_2") (Instruction (Operator Push) (Params [Param $ Integer 1]))) + , (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 2]))) + , (Line Empty (Instruction (Operator Add) Empty)) + ] + parse tokens `shouldBe` (Right $ expected :: Either String AST) + it "rejects multiple instructions in single line" $ do + let input = "push 1 add" + let (Right tokens) = T.tokenize input + parse tokens `shouldBe` (Left "Parse error(s):\n[Operator Push,IntLiteral 1,Operator Add]" :: Either String AST) + it "rejects multiple label definitions in single line" $ do + let input = "label1: label2:" + let (Right tokens) = T.tokenize input + parse tokens `shouldBe` (Left "Parse error(s):\n[Identifier \"label1\",Colon,Identifier \"label2\",Colon]" :: Either String AST) + it "rejects instruction followed by a label definition" $ do + let input = "pop label:" + let (Right tokens) = T.tokenize input + parse tokens `shouldBe` (Left "Parse error(s):\n[Operator Pop,Identifier \"label\",Colon]" :: Either String AST) + it "rejects orphaned identifiers" $ do + let inputs = ["id", "push id", "main: id", "id main:"] + let tokens = map ((\(Right t) -> t) . T.tokenize) inputs + let expected = map Left [ "Parse error(s):\n[Identifier \"id\"]" + , "Parse error(s):\n[Operator Push,Identifier \"id\"]" + , "Parse error(s):\n[Identifier \"main\",Colon,Identifier \"id\"]" + , "Parse error(s):\n[Identifier \"id\",Identifier \"main\",Colon]" + ] :: [Either String AST] + map parse tokens `shouldBe` expected + it "rejects orphaned integers" $ do + let inputs = ["1", "2 :", "3 push", "&4", "label 5 :"] + let tokens = map ((\(Right t) -> t) . T.tokenize) inputs + let expected = map Left [ "Parse error(s):\n[IntLiteral 1]" + , "Parse error(s):\n[IntLiteral 2,Colon]" + , "Parse error(s):\n[IntLiteral 3,Operator Push]" + , "Parse error(s):\n[Ampersand,IntLiteral 4]" + , "Parse error(s):\n[Identifier \"label\",IntLiteral 5,Colon]" + ] :: [Either String AST] + map parse tokens `shouldBe` expected + it "parses example #1" $ do + let input = "main: ; here we define some main label\n\ + \ push 7 ; we push 7 to the stack\n\ + \ push 0x04 ; we push 4 to the stack\n\ + \ call &sum ; we call 'sum' subprogram\n\ + \ halt \n\ + \ \n\ + \ sum: add\n\ + \ ret" + let (Right tokens) = T.tokenize input + -- Labels: Operations: Params: + let expected = Program [ (Line (LabelDef "main") Empty) + , (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 7]))) + , (Line Empty (Instruction (Operator Push) (Params [Param $ Integer 4]))) + , (Line Empty (Instruction (Operator Call) (Params [Param $ LabelRef "sum"]))) + , (Line Empty (Instruction (Operator Halt) Empty)) + , (Line (LabelDef "sum") (Instruction (Operator Add) Empty)) + , (Line Empty (Instruction (Operator Ret) Empty)) + ] + parse tokens `shouldBe` (Right $ expected :: Either String AST) \ No newline at end of file diff --git a/test/Assembler/TokenizerSpec.hs b/test/Assembler/TokenizerSpec.hs index f28a43c..2e17da3 100644 --- a/test/Assembler/TokenizerSpec.hs +++ b/test/Assembler/TokenizerSpec.hs @@ -250,7 +250,7 @@ spec = do let (Just (TokenizeResult _ consumedChars)) = sepTokenizer ('-'==) tokenizer input consumedChars `shouldBe` 3 it "supports empty input irrespective of wrapped tokenizer" $ do - let input = "" + let input = "" let tokenizer _ = success Colon 3 -- MOCK: tokenizer returns Just even though the input is empty sepTokenizer ('-'==) tokenizer input `shouldBe` Nothing @@ -358,7 +358,9 @@ spec = do it "accepts 'call &sum NL" $ tokenize "call &sum \n" `shouldBe` Right [Operator Call, Ampersand, Identifier "sum", NewLine] it "rejects '4push'" $ - tokenize "4push" `shouldBe` Left "Unknown token: 4push" + tokenize "4push" `shouldBe` Left "Unknown token: 4push" + it "supports empty input" $ + tokenize "" `shouldBe` Right [] it "interprets example #1" $ do let input = "main: ; here we define some main label\n\ \ push 7 ; we push 7 to the stack\n\