2024-01-09 01:07:47 +01:00
|
|
|
|
|
|
|
|
|
|
|
-- Test for the lexer
|
|
|
|
|
2024-01-09 18:53:12 +01:00
|
|
|
|
|
|
|
{-
|
|
|
|
TODO:
|
|
|
|
figure out a way to do quickcheck testing:
|
|
|
|
1. generate valid tokens and check they parse
|
|
|
|
|
|
|
|
2. combine two generated tokens together for the combo testing
|
|
|
|
|
|
|
|
this especially will work much better for the postgresql extensible
|
|
|
|
operator tests which doing exhaustively takes ages and doesn't bring
|
|
|
|
much benefit over testing a few using quickcheck.
|
|
|
|
-}
|
|
|
|
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2024-01-09 01:07:47 +01:00
|
|
|
module Language.SQL.SimpleSQL.LexerTests (lexerTests) where
|
|
|
|
|
|
|
|
import Language.SQL.SimpleSQL.TestTypes
|
2024-01-09 18:53:12 +01:00
|
|
|
import Language.SQL.SimpleSQL.Lex
|
|
|
|
(Token(..)
|
|
|
|
,tokenListWillPrintAndLex
|
|
|
|
)
|
2024-02-04 17:00:59 +01:00
|
|
|
import Language.SQL.SimpleSQL.TestRunners
|
2024-01-09 18:53:12 +01:00
|
|
|
|
|
|
|
import qualified Data.Text as T
|
2024-01-10 12:28:34 +01:00
|
|
|
import Data.Text (Text)
|
2024-01-09 18:53:12 +01:00
|
|
|
|
2024-01-09 01:07:47 +01:00
|
|
|
--import Debug.Trace
|
|
|
|
--import Data.Char (isAlpha)
|
2024-01-09 18:53:12 +01:00
|
|
|
-- import Data.List
|
2024-01-09 01:07:47 +01:00
|
|
|
|
|
|
|
lexerTests :: TestItem
|
|
|
|
lexerTests = Group "lexerTests" $
|
2024-01-10 12:28:34 +01:00
|
|
|
[bootstrapTests
|
|
|
|
,ansiLexerTests
|
|
|
|
,postgresLexerTests
|
|
|
|
,sqlServerLexerTests
|
|
|
|
,oracleLexerTests
|
|
|
|
,mySqlLexerTests
|
2024-02-04 17:00:59 +01:00
|
|
|
,odbcLexerTests
|
|
|
|
]
|
2024-01-09 18:53:12 +01:00
|
|
|
|
|
|
|
-- quick sanity tests to see something working
|
|
|
|
bootstrapTests :: TestItem
|
2024-02-04 17:00:59 +01:00
|
|
|
bootstrapTests = Group "bootstrap tests" $
|
|
|
|
[t "iden" [Identifier Nothing "iden"]
|
|
|
|
|
|
|
|
,t "\"a1normal \"\" iden\"" [Identifier (Just ("\"","\"")) "a1normal \"\" iden"]
|
|
|
|
|
|
|
|
,t "'string'" [SqlString "'" "'" "string"]
|
|
|
|
|
|
|
|
,t " " [Whitespace " "]
|
|
|
|
,t "\t " [Whitespace "\t "]
|
|
|
|
,t " \n " [Whitespace " \n "]
|
|
|
|
|
|
|
|
,t "--" [LineComment "--"]
|
|
|
|
,t "--\n" [LineComment "--\n"]
|
|
|
|
,t "--stuff" [LineComment "--stuff"]
|
|
|
|
,t "-- stuff" [LineComment "-- stuff"]
|
|
|
|
,t "-- stuff\n" [LineComment "-- stuff\n"]
|
|
|
|
,t "--\nstuff" [LineComment "--\n", Identifier Nothing "stuff"]
|
|
|
|
,t "-- com \nstuff" [LineComment "-- com \n", Identifier Nothing "stuff"]
|
|
|
|
|
|
|
|
,t "/*test1*/" [BlockComment "/*test1*/"]
|
|
|
|
,t "/**/" [BlockComment "/**/"]
|
|
|
|
,t "/***/" [BlockComment "/***/"]
|
|
|
|
,t "/* * */" [BlockComment "/* * */"]
|
|
|
|
,t "/*test*/" [BlockComment "/*test*/"]
|
|
|
|
,t "/*te/*st*/*/" [BlockComment "/*te/*st*/*/"]
|
|
|
|
,t "/*te*st*/" [BlockComment "/*te*st*/"]
|
|
|
|
,t "/*lines\nmore lines*/" [BlockComment "/*lines\nmore lines*/"]
|
|
|
|
,t "/*test1*/\n" [BlockComment "/*test1*/", Whitespace "\n"]
|
|
|
|
,t "/*test1*/stuff" [BlockComment "/*test1*/", Identifier Nothing "stuff"]
|
|
|
|
|
|
|
|
,t "1" [SqlNumber "1"]
|
|
|
|
,t "42" [SqlNumber "42"]
|
|
|
|
|
|
|
|
,tp "$1" [PositionalArg 1]
|
|
|
|
,tp "$200" [PositionalArg 200]
|
|
|
|
|
|
|
|
,t ":test" [PrefixedVariable ':' "test"]
|
|
|
|
|
|
|
|
] ++ map (\a -> t a [Symbol a]) (
|
2024-01-09 18:53:12 +01:00
|
|
|
["!=", "<>", ">=", "<=", "||"]
|
2024-02-04 17:00:59 +01:00
|
|
|
++ map T.singleton ("(),-+*/<>=." :: [Char]))
|
|
|
|
where
|
|
|
|
t :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
t src ast = testLex ansi2011 src ast
|
|
|
|
tp :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
tp src ast = testLex ansi2011{diPositionalArg=True} src ast
|
2024-01-09 01:07:47 +01:00
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
|
|
|
|
ansiLexerTable :: [(Text,[Token])]
|
2024-01-09 01:07:47 +01:00
|
|
|
ansiLexerTable =
|
|
|
|
-- single char symbols
|
2024-01-10 12:28:34 +01:00
|
|
|
map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;()"
|
2024-01-09 01:07:47 +01:00
|
|
|
-- multi char symbols
|
|
|
|
++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||"]
|
|
|
|
++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
|
|
|
|
-- simple identifiers
|
|
|
|
in map (\i -> (i, [Identifier Nothing i])) idens
|
2024-01-10 12:28:34 +01:00
|
|
|
<> map (\i -> ("\"" <> i <> "\"", [Identifier (Just ("\"","\"")) i])) idens
|
2024-01-09 01:07:47 +01:00
|
|
|
-- todo: in order to make lex . pretty id, need to
|
|
|
|
-- preserve the case of the u
|
2024-01-10 12:28:34 +01:00
|
|
|
<> map (\i -> ("u&\"" <> i <> "\"", [Identifier (Just ("u&\"","\"")) i])) idens
|
2024-01-09 01:07:47 +01:00
|
|
|
-- host param
|
2024-01-10 12:28:34 +01:00
|
|
|
<> map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens
|
2024-01-09 01:07:47 +01:00
|
|
|
)
|
|
|
|
-- quoted identifiers with embedded double quotes
|
|
|
|
-- the lexer doesn't unescape the quotes
|
2024-02-04 17:00:59 +01:00
|
|
|
++ [("\"anormal \"\" iden\"", [Identifier (Just ("\"","\"")) "anormal \"\" iden"])]
|
2024-01-09 01:07:47 +01:00
|
|
|
-- strings
|
|
|
|
-- the lexer doesn't apply escapes at all
|
|
|
|
++ [("'string'", [SqlString "'" "'" "string"])
|
|
|
|
,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
|
|
|
|
,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
|
|
|
|
,("'\n'", [SqlString "'" "'" "\n"])]
|
|
|
|
-- csstrings
|
2024-01-10 12:28:34 +01:00
|
|
|
++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))
|
2024-01-09 01:07:47 +01:00
|
|
|
["n", "N","b", "B","x", "X", "u&"]
|
|
|
|
-- numbers
|
|
|
|
++ [("10", [SqlNumber "10"])
|
|
|
|
,(".1", [SqlNumber ".1"])
|
|
|
|
,("5e3", [SqlNumber "5e3"])
|
|
|
|
,("5e+3", [SqlNumber "5e+3"])
|
|
|
|
,("5e-3", [SqlNumber "5e-3"])
|
|
|
|
,("10.2", [SqlNumber "10.2"])
|
|
|
|
,("10.2e7", [SqlNumber "10.2e7"])]
|
|
|
|
-- whitespace
|
2024-01-10 12:28:34 +01:00
|
|
|
++ concat [[(T.singleton a,[Whitespace $ T.singleton a])
|
|
|
|
,(T.singleton a <> T.singleton b, [Whitespace (T.singleton a <> T.singleton b)])]
|
2024-01-09 01:07:47 +01:00
|
|
|
| a <- " \n\t", b <- " \n\t"]
|
|
|
|
-- line comment
|
|
|
|
++ map (\c -> (c, [LineComment c]))
|
|
|
|
["--", "-- ", "-- this is a comment", "-- line com\n"]
|
|
|
|
-- block comment
|
|
|
|
++ map (\c -> (c, [BlockComment c]))
|
|
|
|
["/**/", "/* */","/* this is a comment */"
|
|
|
|
,"/* this *is/ a comment */"
|
|
|
|
]
|
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
|
2024-01-09 01:07:47 +01:00
|
|
|
ansiLexerTests :: TestItem
|
|
|
|
ansiLexerTests = Group "ansiLexerTests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[Group "ansi lexer token tests" $ [l s t | (s,t) <- ansiLexerTable]
|
2024-01-09 01:07:47 +01:00
|
|
|
,Group "ansi generated combination lexer tests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[ l (s <> s1) (t <> t1)
|
|
|
|
| (s,t) <- ansiLexerTable
|
|
|
|
, (s1,t1) <- ansiLexerTable
|
|
|
|
, tokenListWillPrintAndLex ansi2011 $ t <> t1
|
2024-01-09 01:07:47 +01:00
|
|
|
|
2024-02-04 17:00:59 +01:00
|
|
|
]
|
2024-01-09 01:07:47 +01:00
|
|
|
,Group "ansiadhoclexertests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[l "" []
|
|
|
|
,l "-- line com\nstuff" [LineComment "-- line com\n",Identifier Nothing "stuff"]
|
|
|
|
] ++
|
|
|
|
[-- want to make sure this gives a parse error
|
|
|
|
f "*/"
|
|
|
|
-- combinations of pipes: make sure they fail because they could be
|
|
|
|
-- ambiguous and it is really unclear when they are or not, and
|
|
|
|
-- what the result is even when they are not ambiguous
|
|
|
|
,f "|||"
|
|
|
|
,f "||||"
|
|
|
|
,f "|||||"
|
|
|
|
-- another user experience thing: make sure extra trailing
|
|
|
|
-- number chars are rejected rather than attempting to parse
|
|
|
|
-- if the user means to write something that is rejected by this code,
|
|
|
|
-- then they can use whitespace to make it clear and then it will parse
|
|
|
|
,f "12e3e4"
|
|
|
|
,f "12e3e4"
|
|
|
|
,f "12e3e4"
|
|
|
|
,f "12e3.4"
|
|
|
|
,f "12.4.5"
|
|
|
|
,f "12.4e5.6"
|
|
|
|
,f "12.4e5e7"]
|
|
|
|
]
|
|
|
|
where
|
|
|
|
l :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
l src ast = testLex ansi2011 src ast
|
|
|
|
f :: HasCallStack => Text -> TestItem
|
|
|
|
f src = lexFails ansi2011 src
|
|
|
|
|
2024-01-09 01:07:47 +01:00
|
|
|
|
|
|
|
{-
|
|
|
|
todo: lexing tests
|
|
|
|
do quickcheck testing:
|
|
|
|
can try to generate valid tokens then check they parse
|
|
|
|
|
|
|
|
same as above: can also try to pair tokens, create an accurate
|
|
|
|
function to say which ones can appear adjacent, and test
|
|
|
|
|
|
|
|
I think this plus the explicit lists of tokens like above which do
|
|
|
|
basic sanity + explicit edge casts will provide a high level of
|
|
|
|
assurance.
|
|
|
|
-}
|
|
|
|
|
|
|
|
|
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
postgresLexerTable :: [(Text,[Token])]
|
2024-01-09 01:07:47 +01:00
|
|
|
postgresLexerTable =
|
|
|
|
-- single char symbols
|
2024-01-10 12:28:34 +01:00
|
|
|
map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;():"
|
2024-01-09 01:07:47 +01:00
|
|
|
-- multi char symbols
|
|
|
|
++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]
|
|
|
|
-- generic symbols
|
|
|
|
|
|
|
|
++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
|
|
|
|
-- simple identifiers
|
|
|
|
in map (\i -> (i, [Identifier Nothing i])) idens
|
2024-01-10 12:28:34 +01:00
|
|
|
++ map (\i -> ("\"" <> i <> "\"", [Identifier (Just ("\"","\"")) i])) idens
|
2024-01-09 01:07:47 +01:00
|
|
|
-- todo: in order to make lex . pretty id, need to
|
|
|
|
-- preserve the case of the u
|
2024-01-10 12:28:34 +01:00
|
|
|
++ map (\i -> ("u&\"" <> i <> "\"", [Identifier (Just ("u&\"","\"")) i])) idens
|
2024-01-09 01:07:47 +01:00
|
|
|
-- host param
|
2024-01-10 12:28:34 +01:00
|
|
|
++ map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens
|
2024-01-09 01:07:47 +01:00
|
|
|
)
|
|
|
|
-- positional var
|
|
|
|
++ [("$1", [PositionalArg 1])]
|
|
|
|
-- quoted identifiers with embedded double quotes
|
|
|
|
++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
|
|
|
|
-- strings
|
|
|
|
++ [("'string'", [SqlString "'" "'" "string"])
|
|
|
|
,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
|
|
|
|
,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
|
|
|
|
,("'\n'", [SqlString "'" "'" "\n"])
|
|
|
|
,("E'\n'", [SqlString "E'" "'" "\n"])
|
|
|
|
,("e'this '' quote'", [SqlString "e'" "'" "this '' quote"])
|
|
|
|
,("e'this \\' quote'", [SqlString "e'" "'" "this \\' quote"])
|
|
|
|
,("'not this \\' quote", [SqlString "'" "'" "not this \\"
|
|
|
|
,Whitespace " "
|
|
|
|
,Identifier Nothing "quote"])
|
|
|
|
,("$$ string 1 $$", [SqlString "$$" "$$" " string 1 "])
|
|
|
|
,("$$ string $ 2 $$", [SqlString "$$" "$$" " string $ 2 "])
|
|
|
|
,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])
|
|
|
|
]
|
|
|
|
-- csstrings
|
2024-01-10 12:28:34 +01:00
|
|
|
++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))
|
2024-01-09 01:07:47 +01:00
|
|
|
["n", "N","b", "B","x", "X", "u&", "e", "E"]
|
|
|
|
-- numbers
|
|
|
|
++ [("10", [SqlNumber "10"])
|
|
|
|
,(".1", [SqlNumber ".1"])
|
|
|
|
,("5e3", [SqlNumber "5e3"])
|
|
|
|
,("5e+3", [SqlNumber "5e+3"])
|
|
|
|
,("5e-3", [SqlNumber "5e-3"])
|
|
|
|
,("10.2", [SqlNumber "10.2"])
|
|
|
|
,("10.2e7", [SqlNumber "10.2e7"])]
|
|
|
|
-- whitespace
|
2024-01-10 12:28:34 +01:00
|
|
|
++ concat [[(T.singleton a,[Whitespace $ T.singleton a])
|
|
|
|
,(T.singleton a <> T.singleton b, [Whitespace $ T.singleton a <> T.singleton b])]
|
2024-01-09 01:07:47 +01:00
|
|
|
| a <- " \n\t", b <- " \n\t"]
|
|
|
|
-- line comment
|
|
|
|
++ map (\c -> (c, [LineComment c]))
|
|
|
|
["--", "-- ", "-- this is a comment", "-- line com\n"]
|
|
|
|
-- block comment
|
|
|
|
++ map (\c -> (c, [BlockComment c]))
|
|
|
|
["/**/", "/* */","/* this is a comment */"
|
|
|
|
,"/* this *is/ a comment */"
|
|
|
|
]
|
|
|
|
|
|
|
|
{-
|
|
|
|
An operator name is a sequence of up to NAMEDATALEN-1 (63 by default) characters from the following list:
|
|
|
|
|
|
|
|
+ - * / < > = ~ ! @ # % ^ & | ` ?
|
|
|
|
|
|
|
|
There are a few restrictions on operator names, however:
|
|
|
|
-- and /* cannot appear anywhere in an operator name, since they will be taken as the start of a comment.
|
|
|
|
|
|
|
|
A multiple-character operator name cannot end in + or -, unless the name also contains at least one of these characters:
|
|
|
|
|
|
|
|
~ ! @ # % ^ & | ` ?
|
|
|
|
|
|
|
|
todo: 'negative' tests
|
|
|
|
symbol then --
|
|
|
|
symbol then /*
|
|
|
|
operators without one of the exception chars
|
|
|
|
followed by + or - without whitespace
|
|
|
|
|
|
|
|
also: do the testing for the ansi compatibility special cases
|
|
|
|
-}
|
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
postgresShortOperatorTable :: [(Text,[Token])]
|
2024-01-09 01:07:47 +01:00
|
|
|
postgresShortOperatorTable =
|
|
|
|
[ (x, [Symbol x]) | x <- someValidPostgresOperators 2]
|
|
|
|
|
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
postgresExtraOperatorTable :: [(Text,[Token])]
|
2024-01-09 01:07:47 +01:00
|
|
|
postgresExtraOperatorTable =
|
|
|
|
[ (x, [Symbol x]) | x <- someValidPostgresOperators 4]
|
|
|
|
|
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
someValidPostgresOperators :: Int -> [Text]
|
2024-01-09 01:07:47 +01:00
|
|
|
someValidPostgresOperators l =
|
|
|
|
[ x
|
|
|
|
| n <- [1..l]
|
|
|
|
, x <- combos "+-*/<>=~!@#%^&|`?" n
|
2024-01-10 12:28:34 +01:00
|
|
|
, not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)
|
|
|
|
, not (T.last x `T.elem` "+-")
|
|
|
|
|| or (map (`T.elem` x) "~!@#%^&|`?")
|
2024-01-09 01:07:47 +01:00
|
|
|
]
|
|
|
|
|
|
|
|
{-
|
|
|
|
These are postgres operators, which if followed immediately by a + or
|
|
|
|
-, will lex as separate operators rather than one operator including
|
|
|
|
the + or -.
|
|
|
|
-}
|
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [Text]
|
2024-01-09 01:07:47 +01:00
|
|
|
somePostgresOpsWhichWontAddTrailingPlusMinus l =
|
|
|
|
[ x
|
|
|
|
| n <- [1..l]
|
|
|
|
, x <- combos "+-*/<>=" n
|
2024-01-10 12:28:34 +01:00
|
|
|
, not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)
|
|
|
|
, not (T.last x `T.elem` "+-")
|
2024-01-09 01:07:47 +01:00
|
|
|
]
|
|
|
|
|
|
|
|
postgresLexerTests :: TestItem
|
|
|
|
postgresLexerTests = Group "postgresLexerTests" $
|
|
|
|
[Group "postgres lexer token tests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[l s t | (s,t) <- postgresLexerTable]
|
2024-01-09 01:07:47 +01:00
|
|
|
,Group "postgres generated lexer token tests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[l s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]
|
2024-01-09 01:07:47 +01:00
|
|
|
,Group "postgres generated combination lexer tests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[ l (s <> s1) (t <> t1)
|
2024-01-09 01:07:47 +01:00
|
|
|
| (s,t) <- postgresLexerTable ++ postgresShortOperatorTable
|
|
|
|
, (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable
|
|
|
|
, tokenListWillPrintAndLex postgres $ t ++ t1
|
|
|
|
|
|
|
|
]
|
|
|
|
,Group "generated postgres edgecase lexertests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[l s t
|
2024-01-09 01:07:47 +01:00
|
|
|
| (s,t) <- edgeCaseCommentOps
|
|
|
|
++ edgeCasePlusMinusOps
|
|
|
|
++ edgeCasePlusMinusComments]
|
|
|
|
|
|
|
|
,Group "adhoc postgres lexertests" $
|
|
|
|
-- need more tests for */ to make sure it is caught if it is in the middle of a
|
|
|
|
-- sequence of symbol letters
|
2024-02-04 17:00:59 +01:00
|
|
|
[f "*/"
|
|
|
|
,f ":::"
|
|
|
|
,f "::::"
|
|
|
|
,f ":::::"
|
|
|
|
,f "@*/"
|
|
|
|
,f "-*/"
|
|
|
|
,f "12e3e4"
|
|
|
|
,f "12e3e4"
|
|
|
|
,f "12e3e4"
|
|
|
|
,f "12e3.4"
|
|
|
|
,f "12.4.5"
|
|
|
|
,f "12.4e5.6"
|
|
|
|
,f "12.4e5e7"
|
2024-01-09 01:07:47 +01:00
|
|
|
-- special case allow this to lex to 1 .. 2
|
|
|
|
-- this is for 'for loops' in plpgsql
|
2024-02-04 17:00:59 +01:00
|
|
|
,l "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]
|
|
|
|
]
|
2024-01-09 01:07:47 +01:00
|
|
|
]
|
|
|
|
where
|
|
|
|
edgeCaseCommentOps =
|
2024-01-10 12:28:34 +01:00
|
|
|
[ (x <> "/*<test*/", [Symbol x, BlockComment "/*<test*/"])
|
2024-01-09 01:07:47 +01:00
|
|
|
| x <- eccops
|
2024-01-10 12:28:34 +01:00
|
|
|
, not (T.last x == '*')
|
2024-01-09 01:07:47 +01:00
|
|
|
] ++
|
2024-01-10 12:28:34 +01:00
|
|
|
[ (x <> "--<test", [Symbol x, LineComment "--<test"])
|
2024-01-09 01:07:47 +01:00
|
|
|
| x <- eccops
|
2024-01-10 12:28:34 +01:00
|
|
|
, not (T.last x == '-')
|
2024-01-09 01:07:47 +01:00
|
|
|
]
|
|
|
|
eccops = someValidPostgresOperators 2
|
|
|
|
edgeCasePlusMinusOps = concat
|
2024-01-10 12:28:34 +01:00
|
|
|
[ [ (x <> "+", [Symbol x, Symbol "+"])
|
|
|
|
, (x <> "-", [Symbol x, Symbol "-"]) ]
|
2024-01-09 01:07:47 +01:00
|
|
|
| x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2
|
|
|
|
]
|
|
|
|
edgeCasePlusMinusComments =
|
|
|
|
[("---", [LineComment "---"])
|
|
|
|
,("+--", [Symbol "+", LineComment "--"])
|
|
|
|
,("-/**/", [Symbol "-", BlockComment "/**/"])
|
|
|
|
,("+/**/", [Symbol "+", BlockComment "/**/"])
|
|
|
|
]
|
2024-02-04 17:00:59 +01:00
|
|
|
l :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
l src ast = testLex postgres src ast
|
|
|
|
f :: HasCallStack => Text -> TestItem
|
|
|
|
f src = lexFails postgres src
|
2024-01-09 01:07:47 +01:00
|
|
|
|
|
|
|
sqlServerLexerTests :: TestItem
|
|
|
|
sqlServerLexerTests = Group "sqlServerLexTests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[l s t | (s,t) <-
|
2024-01-09 01:07:47 +01:00
|
|
|
[("@variable", [(PrefixedVariable '@' "variable")])
|
|
|
|
,("#variable", [(PrefixedVariable '#' "variable")])
|
|
|
|
,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])
|
|
|
|
]]
|
2024-02-04 17:00:59 +01:00
|
|
|
where
|
|
|
|
l :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
l src ast = testLex sqlserver src ast
|
2024-01-09 01:07:47 +01:00
|
|
|
|
|
|
|
oracleLexerTests :: TestItem
|
|
|
|
oracleLexerTests = Group "oracleLexTests" $
|
|
|
|
[] -- nothing oracle specific atm
|
|
|
|
|
|
|
|
mySqlLexerTests :: TestItem
|
|
|
|
mySqlLexerTests = Group "mySqlLexerTests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[ l s t | (s,t) <-
|
2024-01-09 01:07:47 +01:00
|
|
|
[("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])
|
|
|
|
]
|
|
|
|
]
|
2024-02-04 17:00:59 +01:00
|
|
|
where
|
|
|
|
l :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
l src ast = testLex mysql src ast
|
2024-01-09 01:07:47 +01:00
|
|
|
|
|
|
|
odbcLexerTests :: TestItem
|
|
|
|
odbcLexerTests = Group "odbcLexTests" $
|
2024-02-04 17:00:59 +01:00
|
|
|
[ lo s t | (s,t) <-
|
2024-01-09 01:07:47 +01:00
|
|
|
[("{}", [Symbol "{", Symbol "}"])
|
|
|
|
]]
|
2024-02-04 17:00:59 +01:00
|
|
|
++ [lno "{"
|
|
|
|
,lno "}"]
|
|
|
|
where
|
|
|
|
lo :: HasCallStack => Text -> [Token] -> TestItem
|
|
|
|
lo src ast = testLex (sqlserver {diOdbc = True}) src ast
|
|
|
|
lno :: HasCallStack => Text -> TestItem
|
|
|
|
lno src = lexFails (sqlserver{diOdbc = False}) src
|
|
|
|
|
2024-01-09 01:07:47 +01:00
|
|
|
|
2024-01-10 12:28:34 +01:00
|
|
|
combos :: [Char] -> Int -> [Text]
|
|
|
|
combos _ 0 = [T.empty]
|
|
|
|
combos l n = [ T.cons x tl | x <- l, tl <- combos l (n - 1) ]
|
2024-02-04 17:00:59 +01:00
|
|
|
|