1
Fork 0

get old lexing code working again, now only 3 tests fail

This commit is contained in:
Jake Wheat 2024-01-10 11:28:34 +00:00
parent 0f307f51c7
commit 4e09fe9f45
5 changed files with 167 additions and 269 deletions

View file

@ -24,10 +24,8 @@ import Language.SQL.SimpleSQL.Lex
,tokenListWillPrintAndLex
)
import Language.SQL.SimpleSQL.Dialect
(ansi2011)
import qualified Data.Text as T
import Data.Text (Text)
--import Debug.Trace
--import Data.Char (isAlpha)
@ -35,12 +33,13 @@ import qualified Data.Text as T
lexerTests :: TestItem
lexerTests = Group "lexerTests" $
[bootstrapTests{-Group "lexer token tests" [ansiLexerTests
,postgresLexerTests
,sqlServerLexerTests
,oracleLexerTests
,mySqlLexerTests
,odbcLexerTests]-}]
[bootstrapTests
,ansiLexerTests
,postgresLexerTests
,sqlServerLexerTests
,oracleLexerTests
,mySqlLexerTests
,odbcLexerTests]
-- quick sanity tests to see something working
bootstrapTests :: TestItem
@ -75,8 +74,9 @@ bootstrapTests = Group "bootstrap tests" $
,("1", [SqlNumber "1"])
,("42", [SqlNumber "42"])
,("$1", [PositionalArg 1])
,("$200", [PositionalArg 200])
-- have to fix the dialect handling in the tests
--,("$1", [PositionalArg 1])
--,("$200", [PositionalArg 200])
,(":test", [PrefixedVariable ':' "test"])
@ -84,22 +84,22 @@ bootstrapTests = Group "bootstrap tests" $
["!=", "<>", ">=", "<=", "||"]
++ map T.singleton ("(),-+*/<>=." :: String)))
{-
ansiLexerTable :: [(String,[Token])]
ansiLexerTable :: [(Text,[Token])]
ansiLexerTable =
-- single char symbols
map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()"
map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;()"
-- 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
++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens
<> map (\i -> ("\"" <> i <> "\"", [Identifier (Just ("\"","\"")) i])) idens
-- todo: in order to make lex . pretty id, need to
-- preserve the case of the u
++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens
<> map (\i -> ("u&\"" <> i <> "\"", [Identifier (Just ("u&\"","\"")) i])) idens
-- host param
++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens
<> map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens
)
-- quoted identifiers with embedded double quotes
-- the lexer doesn't unescape the quotes
@ -111,7 +111,7 @@ ansiLexerTable =
,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
,("'\n'", [SqlString "'" "'" "\n"])]
-- csstrings
++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))
["n", "N","b", "B","x", "X", "u&"]
-- numbers
++ [("10", [SqlNumber "10"])
@ -122,8 +122,8 @@ ansiLexerTable =
,("10.2", [SqlNumber "10.2"])
,("10.2e7", [SqlNumber "10.2e7"])]
-- whitespace
++ concat [[([a],[Whitespace [a]])
,([a,b], [Whitespace [a,b]])]
++ concat [[(T.singleton a,[Whitespace $ T.singleton a])
,(T.singleton a <> T.singleton b, [Whitespace (T.singleton a <> T.singleton b)])]
| a <- " \n\t", b <- " \n\t"]
-- line comment
++ map (\c -> (c, [LineComment c]))
@ -134,14 +134,15 @@ ansiLexerTable =
,"/* this *is/ a comment */"
]
ansiLexerTests :: TestItem
ansiLexerTests = Group "ansiLexerTests" $
[Group "ansi lexer token tests" $ [LexTest ansi2011 s t | (s,t) <- ansiLexerTable]
,Group "ansi generated combination lexer tests" $
[ LexTest ansi2011 (s ++ s1) (t ++ t1)
[ LexTest ansi2011 (s <> s1) (t <> t1)
| (s,t) <- ansiLexerTable
, (s1,t1) <- ansiLexerTable
, tokenListWillPrintAndLex ansi2011 $ t ++ t1
, tokenListWillPrintAndLex ansi2011 $ t <> t1
]
,Group "ansiadhoclexertests" $
@ -185,10 +186,10 @@ assurance.
postgresLexerTable :: [(String,[Token])]
postgresLexerTable :: [(Text,[Token])]
postgresLexerTable =
-- single char symbols
map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;():"
map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;():"
-- multi char symbols
++ map (\s -> (s,[Symbol s])) [">=","<=","!=","<>","||", "::","..",":="]
-- generic symbols
@ -196,12 +197,12 @@ postgresLexerTable =
++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
-- simple identifiers
in map (\i -> (i, [Identifier Nothing i])) idens
++ map (\i -> ("\"" ++ i ++ "\"", [Identifier (Just ("\"","\"")) i])) idens
++ map (\i -> ("\"" <> i <> "\"", [Identifier (Just ("\"","\"")) i])) idens
-- todo: in order to make lex . pretty id, need to
-- preserve the case of the u
++ map (\i -> ("u&\"" ++ i ++ "\"", [Identifier (Just ("u&\"","\"")) i])) idens
++ map (\i -> ("u&\"" <> i <> "\"", [Identifier (Just ("u&\"","\"")) i])) idens
-- host param
++ map (\i -> (':':i, [PrefixedVariable ':' i])) idens
++ map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens
)
-- positional var
++ [("$1", [PositionalArg 1])]
@ -223,7 +224,7 @@ postgresLexerTable =
,("$a$ $$string 3$$ $a$", [SqlString "$a$" "$a$" " $$string 3$$ "])
]
-- csstrings
++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))
["n", "N","b", "B","x", "X", "u&", "e", "E"]
-- numbers
++ [("10", [SqlNumber "10"])
@ -234,8 +235,8 @@ postgresLexerTable =
,("10.2", [SqlNumber "10.2"])
,("10.2e7", [SqlNumber "10.2e7"])]
-- whitespace
++ concat [[([a],[Whitespace [a]])
,([a,b], [Whitespace [a,b]])]
++ concat [[(T.singleton a,[Whitespace $ T.singleton a])
,(T.singleton a <> T.singleton b, [Whitespace $ T.singleton a <> T.singleton b])]
| a <- " \n\t", b <- " \n\t"]
-- line comment
++ map (\c -> (c, [LineComment c]))
@ -267,24 +268,24 @@ operators without one of the exception chars
also: do the testing for the ansi compatibility special cases
-}
postgresShortOperatorTable :: [(String,[Token])]
postgresShortOperatorTable :: [(Text,[Token])]
postgresShortOperatorTable =
[ (x, [Symbol x]) | x <- someValidPostgresOperators 2]
postgresExtraOperatorTable :: [(String,[Token])]
postgresExtraOperatorTable :: [(Text,[Token])]
postgresExtraOperatorTable =
[ (x, [Symbol x]) | x <- someValidPostgresOperators 4]
someValidPostgresOperators :: Int -> [String]
someValidPostgresOperators :: Int -> [Text]
someValidPostgresOperators l =
[ x
| n <- [1..l]
, x <- combos "+-*/<>=~!@#%^&|`?" n
, not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)
, not (last x `elem` "+-")
|| or (map (`elem` x) "~!@#%^&|`?")
, not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)
, not (T.last x `T.elem` "+-")
|| or (map (`T.elem` x) "~!@#%^&|`?")
]
{-
@ -293,13 +294,13 @@ These are postgres operators, which if followed immediately by a + or
the + or -.
-}
somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [String]
somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [Text]
somePostgresOpsWhichWontAddTrailingPlusMinus l =
[ x
| n <- [1..l]
, x <- combos "+-*/<>=" n
, not ("--" `isInfixOf` x || "/*" `isInfixOf` x || "*/" `isInfixOf` x)
, not (last x `elem` "+-")
, not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)
, not (T.last x `T.elem` "+-")
]
@ -310,7 +311,7 @@ postgresLexerTests = Group "postgresLexerTests" $
,Group "postgres generated lexer token tests" $
[LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]
,Group "postgres generated combination lexer tests" $
[ LexTest postgres (s ++ s1) (t ++ t1)
[ LexTest postgres (s <> s1) (t <> t1)
| (s,t) <- postgresLexerTable ++ postgresShortOperatorTable
, (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable
, tokenListWillPrintAndLex postgres $ t ++ t1
@ -344,18 +345,18 @@ postgresLexerTests = Group "postgresLexerTests" $
]
where
edgeCaseCommentOps =
[ (x ++ "/*<test*/", [Symbol x, BlockComment "/*<test*/"])
[ (x <> "/*<test*/", [Symbol x, BlockComment "/*<test*/"])
| x <- eccops
, not (last x == '*')
, not (T.last x == '*')
] ++
[ (x ++ "--<test", [Symbol x, LineComment "--<test"])
[ (x <> "--<test", [Symbol x, LineComment "--<test"])
| x <- eccops
, not (last x == '-')
, not (T.last x == '-')
]
eccops = someValidPostgresOperators 2
edgeCasePlusMinusOps = concat
[ [ (x ++ "+", [Symbol x, Symbol "+"])
, (x ++ "-", [Symbol x, Symbol "-"]) ]
[ [ (x <> "+", [Symbol x, Symbol "+"])
, (x <> "-", [Symbol x, Symbol "-"]) ]
| x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2
]
edgeCasePlusMinusComments =
@ -365,7 +366,6 @@ postgresLexerTests = Group "postgresLexerTests" $
,("+/**/", [Symbol "+", BlockComment "/**/"])
]
sqlServerLexerTests :: TestItem
sqlServerLexerTests = Group "sqlServerLexTests" $
[ LexTest sqlserver s t | (s,t) <-
@ -393,8 +393,6 @@ odbcLexerTests = Group "odbcLexTests" $
++ [LexFails sqlserver {diOdbc = False} "{"
,LexFails sqlserver {diOdbc = False} "}"]
combos :: [a] -> Int -> [[a]]
combos _ 0 = [[]]
combos l n = [ x:tl | x <- l, tl <- combos l (n - 1) ]
-}
combos :: [Char] -> Int -> [Text]
combos _ 0 = [T.empty]
combos l n = [ T.cons x tl | x <- l, tl <- combos l (n - 1) ]

View file

@ -36,7 +36,6 @@ module Language.SQL.SimpleSQL.SQL2011Queries (sql2011QueryTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import qualified Data.Text as T
import Data.Text (Text)
sql2011QueryTests :: TestItem

View file

@ -7,8 +7,6 @@ module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import qualified Data.Text as T
scalarExprTests :: TestItem
scalarExprTests = Group "scalarExprTests"
[literals

View file

@ -58,7 +58,7 @@ testData :: TestItem
testData =
Group "parserTest"
[lexerTests
{-,scalarExprTests
,scalarExprTests
,odbcTests
,queryExprComponentTests
,queryExprsTests
@ -76,7 +76,7 @@ testData =
,oracleTests
,customDialectTests
,emptyStatementTests
,createIndexTests-}
,createIndexTests
]
tests :: T.TestTree