summaryrefslogtreecommitdiff
path: root/source/Test/Unit/Token.hs
diff options
context:
space:
mode:
Diffstat (limited to 'source/Test/Unit/Token.hs')
-rw-r--r--source/Test/Unit/Token.hs285
1 files changed, 0 insertions, 285 deletions
diff --git a/source/Test/Unit/Token.hs b/source/Test/Unit/Token.hs
deleted file mode 100644
index d399e2a..0000000
--- a/source/Test/Unit/Token.hs
+++ /dev/null
@@ -1,285 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-
-module Test.Unit.Token (unitTests) where
-
-import Base
-import Report.Location
-import Syntax.Adapt
-import Syntax.Abstract (Associativity(..))
-import Syntax.Interface
-import Syntax.Pragma
-import Syntax.Token
-
-import Data.Text qualified as Text
-import Test.Tasty
-import Test.Tasty.HUnit
-import Text.Megaparsec (errorBundlePretty)
-
-unitTests :: TestTree
-unitTests = testGroup "Lexer"
- [ testCase "nested math inside text returns to text" nestedMathInsideText
- , testCase "nested text and math returns to the enclosing frame" deeperAlternation
- , testCase "braces inside text do not close the text frame" textBraceNesting
- , testCase "cases is tokenized as an environment only inside math" casesOnlyInsideMath
- , testCase "imports retain source locations and POSIX spellings" locatedImports
- , testCase "commented environment starts are ignored"
- ignoresCommentedEnvironmentStart
- , testCase "empty inputs construct empty lexical syntax"
- constructsEmptyLexicalSyntax
- , testCase "extracts exact source fixity pragmas"
- extractsSourceFixityPragmas
- , testCase "rejects malformed reserved pragma lines"
- rejectsMalformedPragmas
- ]
-
-nestedMathInsideText :: Assertion
-nestedMathInsideText = do
- tokens <- tokensInProof "$\\text{if $x \\in A$ then}$"
- tokens `shouldBe`
- [ BeginEnv "proof"
- , BeginEnv "math"
- , BeginEnv "text"
- , Word "if"
- , BeginEnv "math"
- , Variable "x"
- , Command "in"
- , Variable "A"
- , EndEnv "math"
- , Word "then"
- , EndEnv "text"
- , EndEnv "math"
- , EndEnv "proof"
- ]
-
-deeperAlternation :: Assertion
-deeperAlternation = do
- tokens <- tokensInProof "$\\text{a $ \\text{b $c$ d} e$ f}$"
- tokens `shouldBe`
- [ BeginEnv "proof"
- , BeginEnv "math"
- , BeginEnv "text"
- , Word "a"
- , BeginEnv "math"
- , BeginEnv "text"
- , Word "b"
- , BeginEnv "math"
- , Variable "c"
- , EndEnv "math"
- , Word "d"
- , EndEnv "text"
- , Variable "e"
- , EndEnv "math"
- , Word "f"
- , EndEnv "text"
- , EndEnv "math"
- , EndEnv "proof"
- ]
-
-textBraceNesting :: Assertion
-textBraceNesting = do
- tokens <- tokensInProof "$\\text{a {b}}$"
- tokens `shouldBe`
- [ BeginEnv "proof"
- , BeginEnv "math"
- , BeginEnv "text"
- , Word "a"
- , InvisibleBraceL
- , Word "b"
- , InvisibleBraceR
- , EndEnv "text"
- , EndEnv "math"
- , EndEnv "proof"
- ]
-
-casesOnlyInsideMath :: Assertion
-casesOnlyInsideMath = do
- tokensInsideMath <- tokensInProof "$\\begin{cases}x\\end{cases}$"
- tokensInsideMath `shouldBe`
- [ BeginEnv "proof"
- , BeginEnv "math"
- , BeginEnv "cases"
- , Variable "x"
- , EndEnv "cases"
- , EndEnv "math"
- , EndEnv "proof"
- ]
-
- tokensOutsideMath <- tokensInProof "\\begin{cases}x\\end{cases}"
- assertBool
- "cases should not be tokenized as an environment outside math"
- (BeginEnv "cases" `notElem` tokensOutsideMath && EndEnv "cases" `notElem` tokensOutsideMath)
-
-locatedImports :: Assertion
-locatedImports = do
- let raw = Text.unlines
- [ "% heading"
- , "\\import{set/base.tex}"
- , "\\import{set\\special.tex}"
- , "\\begin{axiom}"
- , " $x = x$."
- , "\\end{axiom}"
- ]
- case gatherImports (FileId maxBound) "import-unit" raw of
- Left err ->
- assertFailure (errorBundlePretty err)
- Right imports@[firstImport, secondImport] -> do
- assertEqual
- "import paths"
- ["set/base.tex", "set\\special.tex"]
- (unLocated <$> imports)
- assertEqual "first import line" 2 (locLine (startPos firstImport))
- assertEqual "second import line" 3 (locLine (startPos secondImport))
- Right imports ->
- assertFailure ("expected two imports, got " <> show imports)
-
-ignoresCommentedEnvironmentStart :: Assertion
-ignoresCommentedEnvironmentStart = do
- let raw = Text.unlines
- [ "% \\begin{signature}"
- , "ordinary text"
- , "\\begin{struct}"
- , " an ordered set $X$ is a onesorted structure."
- , "\\end{struct}"
- ]
- (_, chunks) <-
- either
- (assertFailure . errorBundlePretty)
- pure
- (runLexer (FileId maxBound) "commented-environment" raw)
- case chunks of
- [Located{unLocated = BeginEnv "struct"} : _] -> pure ()
- _ -> assertFailure ("expected the real structure environment, got " <> show chunks)
-
-constructsEmptyLexicalSyntax :: Assertion
-constructsEmptyLexicalSyntax =
- forM_
- [ ("empty", "")
- , ("comment-only", "% heading\n% body")
- ]
- \(description, raw) -> do
- let input = Text.pack raw
- imports <-
- either
- (assertFailure . errorBundlePretty)
- pure
- (gatherImports
- (FileId maxBound)
- description
- input)
- assertEqual (description <> " imports") [] imports
- (lexedImports, chunks) <-
- either
- (assertFailure . errorBundlePretty)
- pure
- (runLexer
- (FileId maxBound)
- description
- input)
- assertEqual (description <> " lexer imports") [] lexedImports
- assertEqual (description <> " chunks") [] chunks
- scanned <-
- either
- (assertFailure . show)
- pure
- (concat <$> traverse scanChunk chunks)
- assertEqual (description <> " scanned declarations") [] scanned
- delta <-
- either
- (assertFailure . show)
- pure
- (canonicalSyntaxDelta [])
- assertBool
- (description <> " syntax declarations")
- (null (canonicalSyntaxDeltaEntries delta))
-
-extractsSourceFixityPragmas :: Assertion
-extractsSourceFixityPragmas = do
- let input =
- " %! infixl 0\n"
- <> "\t%! infixr 07\r\n"
- <> "%! infix 3"
- ordinaryComments =
- Text.unlines
- [ "% ! infixl 1"
- , "text %! infixr 2"
- , "% ordinary"
- ]
- pragmas <-
- either
- (assertFailure . Text.unpack . renderSyntaxPragmaError)
- pure
- (extractSyntaxPragmas
- (FileId maxBound)
- "pragma-unit"
- input)
- assertEqual
- "normalized pragmas"
- [ (LeftAssoc, 0, 1, 3)
- , (RightAssoc, 7, 2, 2)
- , (NonAssoc, 3, 3, 1)
- ]
- [ ( syntaxPragmaAssociativity pragma
- , sourceMixfixLevelValue (syntaxPragmaLevel pragma)
- , locLine (syntaxPragmaLocation pragma)
- , locColumn (syntaxPragmaLocation pragma)
- )
- | pragma <- pragmas
- ]
- assertEqual
- "ordinary comments"
- (Right [])
- (extractSyntaxPragmas
- (FileId maxBound)
- "pragma-unit"
- ordinaryComments)
-
-rejectsMalformedPragmas :: Assertion
-rejectsMalformedPragmas =
- forM_
- [ ("%!infixl 1\n", SyntaxPragmaMissingSpaceAfterPrefix)
- , ("%!\n", SyntaxPragmaMissingKeyword)
- , ("%! Infixl 1\n", SyntaxPragmaUnknownKeyword "Infixl")
- , ("%! infixl\n", SyntaxPragmaMissingLevel)
- , ("%! infixl -1\n", SyntaxPragmaInvalidLevel)
- , ("%! infixl ١\n", SyntaxPragmaInvalidLevel)
- , ("%! infixl 8\n", SyntaxPragmaLevelOutOfRange)
- , ("%! infixl 1 extra\n", SyntaxPragmaTrailingContent)
- , ("%! infixl 1\r", SyntaxPragmaLoneCarriageReturn)
- ]
- \(input, expectedProblem) ->
- case extractSyntaxPragmas
- (FileId maxBound)
- "pragma-unit"
- input of
- Left (InvalidSyntaxPragma location actualProblem) -> do
- assertEqual
- ("problem for " <> show input)
- expectedProblem
- actualProblem
- assertEqual "error line" 1 (locLine location)
- assertEqual "error column" 1 (locColumn location)
- Left err ->
- assertFailure
- ("unexpected pragma error: "
- <> Text.unpack (renderSyntaxPragmaError err))
- Right pragmas ->
- assertFailure
- ("expected malformed pragma rejection, got "
- <> show pragmas)
-
-tokensInProof :: Text -> IO [Token]
-tokensInProof raw =
- case runLexer (FileId maxBound) "lexer-unit" wrapped of
- Left err ->
- assertFailure (errorBundlePretty err)
- Right (_imports, chunks) ->
- pure (concatMap (map unLocated) chunks)
- where
- wrapped = Text.unlines
- [ "\\begin{proof}"
- , raw
- , "\\end{proof}"
- ]
-
-shouldBe :: (Eq a, Show a, HasCallStack) => a -> a -> Assertion
-shouldBe = flip (assertEqual "")
generated by cgit v1.2.3 (git 2.39.1) at 2026-08-06 19:08:36 +0000