151 lines
3.8 KiB
Idris
151 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 "★"]
|
|||
|
]
|
|||
|
]
|