150 lines
3.8 KiB
Idris
150 lines
3.8 KiB
Idris
module Tests.Lexer
|
||
|
||
import Quox.Name
|
||
import Quox.Lexer
|
||
import Text.Lexer.Tokenizer
|
||
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}｣" {e = Failure} $
|
||
case lex str of
|
||
Left err => throwError $ LexError err
|
||
Right res =>
|
||
let res = map val res in
|
||
unless (toks == res) $ throwError $ WrongLex toks res
|
||
|
||
private
|
||
lexFail : String -> Test
|
||
lexFail str = test "｢\{denewline str}｣ # fails" {e = Failure} $
|
||
case lex str of
|
||
Left err => pure ()
|
||
Right res => throwError $ ExpectedFail $ map val res
|
||
|
||
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{-comment-}def" [I "abc", I "def"],
|
||
lexes "λ" [R "λ"],
|
||
lexes "fun" [R "λ"],
|
||
lexes "δ" [R "δ"],
|
||
lexes "dfun" [R "δ"],
|
||
lexes "funky" [I "funky"],
|
||
lexes "δελτα" [I "δελτα"],
|
||
lexes "a.b.c.d.e" [I $ MakeName [< "a","b","c","d"] "e"],
|
||
lexes "normalïse" [I "normalïse"],
|
||
-- ↑ 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 $ 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 "+'"],
|
||
lexFail "'+"
|
||
],
|
||
|
||
"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 "}"],
|
||
lexFail "` {}",
|
||
-- [todo] should this be lexed as "`{", "-", "mid", etc?
|
||
lexFail "`{-mid token comment-}{}"
|
||
],
|
||
|
||
"tags" :- [
|
||
lexes "`a" [T "a"],
|
||
lexes "`abc" [T "abc"],
|
||
lexes "`+" [T "+"],
|
||
lexes "`$$$" [T "$$$"],
|
||
lexes #"`"multi word tag""# [T "multi word tag"],
|
||
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 "★"]
|
||
]
|
||
]
|