165 lines
4.6 KiB
Idris
165 lines
4.6 KiB
Idris
module Tests.Lexer
|
||
|
||
import Quox.Name
|
||
import Quox.Parser.Lexer
|
||
import TAP
|
||
|
||
|
||
private
|
||
data Failure = LexError Lexer.Error
|
||
| WrongLex (List Token) (List Token)
|
||
| ExpectedFail (List Token)
|
||
|
||
private
|
||
ToInfo Failure where
|
||
toInfo (LexError err) =
|
||
[("type", "LexError"),
|
||
("info", show err)]
|
||
toInfo (WrongLex want got) =
|
||
[("type", "WrongLex"),
|
||
("want", show want),
|
||
("got", show got)]
|
||
toInfo (ExpectedFail got) =
|
||
[("type", "ExpectedFail"),
|
||
("got", show got)]
|
||
|
||
|
||
private
|
||
denewline : String -> String
|
||
denewline = pack . map (\case '\n' => ''; c => c) . unpack
|
||
|
||
private
|
||
lexes : String -> List Token -> Test
|
||
lexes str toks = test "｢\{denewline str}｣" $ do
|
||
res <- bimap LexError (map val) $ lex str
|
||
unless (toks == res) $ throwError $ WrongLex toks res
|
||
|
||
private
|
||
lexFail : String -> Test
|
||
lexFail str = test "｢\{denewline str}｣ # fails" $
|
||
either (const $ Right ()) (Left . ExpectedFail . map val) $ lex str
|
||
|
||
export
|
||
tests : Test
|
||
tests = "lexer" :- [
|
||
"comments" :- [
|
||
lexes "" [],
|
||
lexes " " [],
|
||
lexes "-- line comment" [],
|
||
lexes "name -- line comment" [Name "name"],
|
||
lexes "-- line comment\nnameBetween -- and another" [Name "nameBetween"],
|
||
lexes "{- block comment -}" [],
|
||
lexes "{- {- nested -} block comment -}" []
|
||
],
|
||
|
||
"identifiers & keywords" :- [
|
||
lexes "abc" [Name "abc"],
|
||
lexes "abc def" [Name "abc", Reserved "def"],
|
||
lexes "abc_def" [Name "abc_def"],
|
||
lexes "abc-def" [Name "abc-def"],
|
||
lexes "abc{-comment-}def" [Name "abc", Reserved "def"],
|
||
lexes "λ" [Reserved "λ"],
|
||
lexes "fun" [Reserved "λ"],
|
||
lexes "δ" [Reserved "δ"],
|
||
lexes "dfun" [Reserved "δ"],
|
||
lexes "funky" [Name "funky"],
|
||
lexes "δελτα" [Name "δελτα"],
|
||
lexes "★★" [Name "★★"],
|
||
lexes "Types" [Name "Types"],
|
||
lexes "a.b.c.d.e" [Name $ MakePName [< "a","b","c","d"] "e"],
|
||
lexes "normalïse" [Name "normalïse"],
|
||
-- ↑ replace i + combining ¨ with precomposed ï
|
||
lexes "map#" [Name "map#"],
|
||
lexes "write!" [Name "write!"],
|
||
lexes "uhh??!?!?!?" [Name "uhh??!?!?!?"],
|
||
|
||
todo "check for reserved words in a qname",
|
||
skip $
|
||
lexes "abc.fun.def"
|
||
[Name "abc", Reserved ".", Reserved "λ", Reserved ".", Name "def"],
|
||
|
||
lexes "+" [Name "+"],
|
||
lexes "*" [Name "*"],
|
||
lexes "**" [Reserved "×"],
|
||
lexes "***" [Name "***"],
|
||
lexes "+**" [Name "+**"],
|
||
lexes "+#" [Name "+#"],
|
||
lexes "+.+.+" [Name $ MakePName [< "+", "+"] "+"],
|
||
lexes "a.+" [Name $ MakePName [< "a"] "+"],
|
||
lexes "+.a" [Name $ MakePName [< "+"] "a"],
|
||
|
||
lexes "+a" [Name "+", Name "a"],
|
||
|
||
lexes "x." [Name "x", Reserved "."],
|
||
lexes "&." [Name "&", Reserved "."],
|
||
lexes ".x" [Reserved ".", Name "x"],
|
||
lexes "a.b.c." [Name $ MakePName [< "a", "b"] "c", Reserved "."],
|
||
|
||
lexes "case" [Reserved "case"],
|
||
lexes "caseω" [Reserved "caseω"],
|
||
lexes "case#" [Reserved "caseω"],
|
||
lexes "case1" [Reserved "case1"],
|
||
lexes "case0" [Reserved "case0"],
|
||
lexes "case##" [Name "case##"],
|
||
|
||
lexes "_" [Reserved "_"],
|
||
lexes "_a" [Name "_a"],
|
||
lexes "a_" [Name "a_"],
|
||
|
||
lexes "a'" [Name "a'"],
|
||
lexes "+'" [Name "+'"],
|
||
|
||
lexes "a₁" [Name "a₁"],
|
||
lexes "a⁰" [Name "a", Sup 0],
|
||
lexes "a^0" [Name "a", Sup 0],
|
||
|
||
lexes "0.x" [Nat 0, Reserved ".", Name "x"],
|
||
lexes "1.x" [Nat 1, Reserved ".", Name "x"],
|
||
lexes "ω.x" [Reserved "ω", Reserved ".", Name "x"],
|
||
lexes "#.x" [Reserved "ω", Reserved ".", Name "x"]
|
||
],
|
||
|
||
"syntax characters" :- [
|
||
lexes "()" [Reserved "(", Reserved ")"],
|
||
lexes "(a)" [Reserved "(", Name "a", Reserved ")"],
|
||
lexFail "(^)",
|
||
lexes "{a,b}"
|
||
[Reserved "{", Name "a", Reserved ",", Name "b", Reserved "}"],
|
||
lexes "{+,-}"
|
||
[Reserved "{", Name "+", Reserved ",", Name "-", Reserved "}"]
|
||
],
|
||
|
||
"tags" :- [
|
||
lexes #" 'a "# [Tag "a"],
|
||
lexes #" 'abc "# [Tag "abc"],
|
||
lexes #" '+ "# [Tag "+"],
|
||
lexes #" '$$$ "# [Tag "$$$"],
|
||
lexes #" 'tag.with.dots "# [Tag "tag.with.dots"],
|
||
lexes #" '"multi word tag" "# [Tag "multi word tag"],
|
||
lexes #" '"" "# [Tag ""],
|
||
lexFail #" ' "#,
|
||
lexFail #" '' "#
|
||
],
|
||
|
||
"strings" :- [
|
||
lexes #" "" "# [Str ""],
|
||
lexes #" "abc" "# [Str "abc"],
|
||
lexes #" "\"" "# [Str "\""],
|
||
lexes #" "\\" "# [Str "\\"],
|
||
lexes #" "\\\"" "# [Str "\\\""],
|
||
todo "other escapes"
|
||
],
|
||
|
||
todo "naturals",
|
||
|
||
"universes" :- [
|
||
lexes "Type0" [TYPE 0],
|
||
lexes "Type⁰" [Reserved "★", Sup 0],
|
||
lexes "Type9999999" [TYPE 9999999],
|
||
lexes "★⁰" [Reserved "★", Sup 0],
|
||
lexes "★⁶⁹" [Reserved "★", Sup 69],
|
||
lexes "★4" [TYPE 4],
|
||
lexes "Type" [Reserved "★"],
|
||
lexes "★" [Reserved "★"]
|
||
]
|
||
]
|