150 lines
3.9 KiB
Idris
150 lines
3.9 KiB
Idris
module Tests.Lexer
|
||
|
||
import Quox.Name
|
||
import Quox.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" [I "name"],
|
||
lexes "-- line comment\nnameBetween -- and another" [I "nameBetween"],
|
||
lexes "{- block comment -}" [],
|
||
lexes "{- {- nested -} block comment -}" []
|
||
],
|
||
|
||
"identifiers & keywords" :- [
|
||
lexes "abc" [I "abc"],
|
||
lexes "abc def" [I "abc", I "def"],
|
||
lexes "abc_def" [I "abc_def"],
|
||
lexes "abc-def" [I "abc-def"],
|
||
lexes "abc{-comment-}def" [I "abc", I "def"],
|
||
lexes "λ" [R "λ"],
|
||
lexes "fun" [R "λ"],
|
||
lexes "δ" [R "δ"],
|
||
lexes "dfun" [R "δ"],
|
||
lexes "funky" [I "funky"],
|
||
lexes "δελτα" [I "δελτα"],
|
||
lexes "★★" [I "★★"],
|
||
lexes "Types" [I "Types"],
|
||
lexes "a.b.c.d.e" [I $ MakeName [< "a","b","c","d"] "e"],
|
||
lexes "normalïse" [I "normalïse"],
|
||
lexes "map#" [I "map#"],
|
||
lexes "write!" [I "write!"],
|
||
lexes "uhh??!?!?!?" [I "uhh??!?!?!?"],
|
||
-- ↑ replace i + combining ¨ with precomposed ï
|
||
|
||
todo "check for reserved words in a qname",
|
||
-- lexes "abc.fun.def" [I "abc", R ".", R "λ", R ".", I "def"],
|
||
|
||
lexes "+" [I "+"],
|
||
lexes "*" [I "*"],
|
||
lexes "**" [R "×"],
|
||
lexes "***" [I "***"],
|
||
lexes "+**" [I "+**"],
|
||
lexes "+#" [I "+#"],
|
||
lexes "+.+.+" [I $ MakeName [< "+", "+"] "+"],
|
||
lexes "a.+" [I $ MakeName [< "a"] "+"],
|
||
lexes "+.a" [I $ MakeName [< "+"] "a"],
|
||
|
||
lexes "+a" [I "+", I "a"],
|
||
|
||
lexes "x." [I "x", R "·"],
|
||
lexes "&." [I "&", R "·"],
|
||
lexes ".x" [R "·", I "x"],
|
||
lexes "a.b.c." [I $ MakeName [< "a", "b"] "c", R "·"],
|
||
|
||
lexes "case" [R "case"],
|
||
lexes "caseω" [R "caseω"],
|
||
lexes "case#" [R "caseω"],
|
||
lexes "case1" [R "case1"],
|
||
lexes "case0" [I "case0"],
|
||
lexes "case##" [I "case##"],
|
||
|
||
lexes "_" [R "_"],
|
||
lexes "_a" [I "_a"],
|
||
lexes "a_" [I "a_"],
|
||
|
||
lexes "a'" [I "a'"],
|
||
lexes "+'" [I "+'"]
|
||
],
|
||
|
||
"syntax characters" :- [
|
||
lexes "()" [R "(", R ")"],
|
||
lexes "(a)" [R "(", I "a", R ")"],
|
||
lexes "(^)" [R "(", I "^", R ")"],
|
||
lexes "{a,b}" [R "{", I "a", R ",", I "b", R "}"],
|
||
lexes "{+,-}" [R "{", I "+", R ",", I "-", R "}"]
|
||
],
|
||
|
||
"tags" :- [
|
||
lexes #" 'a "# [T "a"],
|
||
lexes #" 'abc "# [T "abc"],
|
||
lexes #" '+ "# [T "+"],
|
||
lexes #" '$$$ "# [T "$$$"],
|
||
lexes #" 'tag.with.dots "# [T "tag.with.dots"],
|
||
lexes #" '"multi word tag" "# [T "multi word tag"],
|
||
lexes #" '"" "# [T ""],
|
||
lexFail #" ' "#,
|
||
lexFail #" '' "#
|
||
],
|
||
|
||
"strings" :- [
|
||
lexes #" "" "# [S ""],
|
||
lexes #" "abc" "# [S "abc"],
|
||
lexes #" "\"" "# [S "\""],
|
||
lexes #" "\\" "# [S "\\"],
|
||
lexes #" "\\\"" "# [S "\\\""],
|
||
todo "other escapes"
|
||
],
|
||
|
||
"universes" :- [
|
||
lexes "Type0" [TYPE 0],
|
||
lexes "Type₀" [TYPE 0],
|
||
lexes "Type9999999" [TYPE 9999999],
|
||
lexes "★₀" [TYPE 0],
|
||
lexes "★₆₉" [TYPE 69],
|
||
lexes "★4" [TYPE 4],
|
||
lexes "Type" [R "★"],
|
||
lexes "★" [R "★"]
|
||
]
|
||
]
|