Basic lexer testing
This commit is contained in:
parent
4410e67590
commit
68f9b88c83
2 changed files with 28 additions and 13 deletions
|
|
@ -46,6 +46,7 @@ test-suite haddock2-test
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
main-is: Spec.hs
|
main-is: Spec.hs
|
||||||
build-depends:
|
build-depends:
|
||||||
|
parsec ^>=3.1.18.0,
|
||||||
base >=4.20.1.0,
|
base >=4.20.1.0,
|
||||||
haddock2:{haddock2-lib},
|
haddock2:{haddock2-lib},
|
||||||
hspec ^>=2.11.0,
|
hspec ^>=2.11.0,
|
||||||
|
|
|
||||||
40
test/Spec.hs
40
test/Spec.hs
|
|
@ -5,23 +5,14 @@ import Test.Hspec
|
||||||
|
|
||||||
import Data.String (IsString (..))
|
import Data.String (IsString (..))
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Text.Parsec.Pos
|
||||||
|
|
||||||
|
import Control.Monad (zipWithM_)
|
||||||
import Identifier (Identifier)
|
import Identifier (Identifier)
|
||||||
import Lexer
|
import Lexer
|
||||||
import Parser
|
import Parser
|
||||||
import Types
|
import Types
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = hspec $ do
|
|
||||||
describe "Lexer" do
|
|
||||||
it "lexes" do
|
|
||||||
lexer "This is string" `shouldBe` undefined
|
|
||||||
describe "Parser" do
|
|
||||||
it "Bold" do
|
|
||||||
"__bold__" `shouldParseTo` (DocBold (DocString "bold"))
|
|
||||||
it "Emphasis" do
|
|
||||||
"/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis"))
|
|
||||||
|
|
||||||
shouldParseTo :: Text -> DocMarkup mod Identifier -> Expectation
|
shouldParseTo :: Text -> DocMarkup mod Identifier -> Expectation
|
||||||
shouldParseTo input ast = parseText input `shouldBe` ast
|
shouldParseTo input ast = parseText input `shouldBe` ast
|
||||||
|
|
||||||
|
|
@ -30,5 +21,28 @@ type Doc id = DocMarkup () id
|
||||||
instance IsString (Doc String) where
|
instance IsString (Doc String) where
|
||||||
fromString = DocString
|
fromString = DocString
|
||||||
|
|
||||||
file :: IO String
|
main :: IO ()
|
||||||
file = readFile "test/markup.md"
|
main = hspec $ do
|
||||||
|
describe "Lexer" do
|
||||||
|
it "bare string" do
|
||||||
|
"some string" `shouldLexTo` [(1, 1, Token "some"), (1, 5, Space), (1, 6, Token "string")]
|
||||||
|
it "emphasis" do
|
||||||
|
"has /emphatic/ content" `shouldLexTo` replicate 7 (0, 0, Space)
|
||||||
|
describe "Parser" do
|
||||||
|
it "Bold" do
|
||||||
|
"__bold__" `shouldParseTo` (DocBold (DocString "bold"))
|
||||||
|
it "Emphasis" do
|
||||||
|
"/emphasis/" `shouldParseTo` (DocEmphasis (DocString "emphasis"))
|
||||||
|
|
||||||
|
shouldLexTo :: String -> [(Int, Int, Token)] -> Expectation
|
||||||
|
shouldLexTo input expected =
|
||||||
|
case lexer input of
|
||||||
|
Right tokens -> do
|
||||||
|
length tokens `shouldBe` length expected
|
||||||
|
zipWithM_ checkToken tokens expected
|
||||||
|
Left err -> expectationFailure $ "Parse error: " <> show err
|
||||||
|
where
|
||||||
|
checkToken (pos, tok) (line, col, expectedTok) = do
|
||||||
|
tok `shouldBe` expectedTok
|
||||||
|
sourceLine pos `shouldBe` line
|
||||||
|
sourceColumn pos `shouldBe` col
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue