new syntax for names and string literals
This commit is contained in:
parent
1b4eefc431
commit
52f035b718
8 changed files with 150 additions and 165 deletions
tools/Language/SQL/SimpleSQL
|
@ -7,9 +7,10 @@ Test for the lexer
|
|||
> import Language.SQL.SimpleSQL.TestTypes
|
||||
> import Language.SQL.SimpleSQL.Lex (Token(..))
|
||||
> --import Debug.Trace
|
||||
> import Data.Char (isAlpha)
|
||||
|
||||
> lexerTable :: [(String,[Token])]
|
||||
> lexerTable =
|
||||
> ansiLexerTable :: [(String,[Token])]
|
||||
> ansiLexerTable =
|
||||
> -- single char symbols
|
||||
> map (\s -> ([s],[Symbol [s]])) "+-^*/%~&|?<>[]=,;()"
|
||||
> -- multi char symbols
|
||||
|
@ -17,21 +18,21 @@ Test for the lexer
|
|||
> ++ (let idens = ["a", "_a", "test", "table", "Stuff", "STUFF"]
|
||||
> -- simple identifiers
|
||||
> in map (\i -> (i, [Identifier i])) idens
|
||||
> ++ map (\i -> ("\"" ++ i ++ "\"", [QIdentifier i])) idens
|
||||
> ++ map (\i -> ("\"" ++ i ++ "\"", [QuotedIdentifier "\"" "\"" i])) idens
|
||||
> -- todo: in order to make lex . pretty id, need to
|
||||
> -- preserve the case of the u
|
||||
> ++ map (\i -> ("u&\"" ++ i ++ "\"", [UQIdentifier i])) idens
|
||||
> ++ map (\i -> ("u&\"" ++ i ++ "\"", [QuotedIdentifier "u&\"" "\"" i])) idens
|
||||
> -- host param
|
||||
> ++ map (\i -> (':':i, [HostParam i])) idens
|
||||
> )
|
||||
> -- quoted identifiers with embedded double quotes
|
||||
> ++ [("\"normal \"\" iden\"", [QIdentifier "normal \" iden"])]
|
||||
> ++ [("\"normal \"\" iden\"", [QuotedIdentifier "\"" "\"" "normal \" iden"])]
|
||||
> -- strings
|
||||
> ++ [("'string'", [SqlString "string"])
|
||||
> ,("'normal '' quote'", [SqlString "normal ' quote"])
|
||||
> ,("'normalendquote '''", [SqlString "normalendquote '"])]
|
||||
> ++ [("'string'", [SqlString "'" "'" "string"])
|
||||
> ,("'normal '' quote'", [SqlString "'" "'" "normal ' quote"])
|
||||
> ,("'normalendquote '''", [SqlString "'" "'" "normalendquote '"])]
|
||||
> -- csstrings
|
||||
> ++ map (\c -> (c ++ "'test'", [CSSqlString c "test"]))
|
||||
> ++ map (\c -> (c ++ "'test'", [SqlString (c ++ "'") "'" "test"]))
|
||||
> ["n", "N","b", "B","x", "X", "u&"]
|
||||
> -- numbers
|
||||
> ++ [("10", [SqlNumber "10"])
|
||||
|
@ -54,14 +55,18 @@ Test for the lexer
|
|||
> ,"/* this *is/ a comment */"
|
||||
> ]
|
||||
|
||||
|
||||
> lexerTests :: TestItem
|
||||
> lexerTests = Group "lexerTests" $
|
||||
> [Group "lexer token tests" $ [LexerTest ansi2011 s t | (s,t) <- lexerTable]
|
||||
> ,Group "generated combination lexer tests" $
|
||||
> [Group "lexer token tests" [ansiLexerTests]]
|
||||
|
||||
|
||||
> ansiLexerTests :: TestItem
|
||||
> ansiLexerTests = Group "ansiLexerTests" $
|
||||
> [Group "ansi lexer token tests" $ [LexerTest ansi2011 s t | (s,t) <- ansiLexerTable]
|
||||
> ,Group "ansi generated combination lexer tests" $
|
||||
> [ LexerTest ansi2011 (s ++ s1) (t ++ t1)
|
||||
> | (s,t) <- lexerTable
|
||||
> , (s1,t1) <- lexerTable
|
||||
> | (s,t) <- ansiLexerTable
|
||||
> , (s1,t1) <- ansiLexerTable
|
||||
|
||||
which combinations won't work:
|
||||
<> <= >= || two single symbols which make a double char symbol
|
||||
|
@ -101,17 +106,16 @@ number number (todo: double check more carefully)
|
|||
> ,symbolPair "*" "/"
|
||||
|
||||
> ,(isIdentifier, isIdentifier)
|
||||
> ,(isQIdentifier, isQIdentifier)
|
||||
> ,(isUQIdentifier, isQIdentifier)
|
||||
> ,(isString, isString)
|
||||
> ,(isCsString, isString)
|
||||
> ,(isDQIdentifier, isDQIdentifier)
|
||||
> ,(isCQIdentifier, isDQIdentifier)
|
||||
> ,(isString, isNonCsString)
|
||||
> ,(isEofLineComment, const True)
|
||||
> ,(isNumber, isNumber)
|
||||
> ,(isHostParam,isIdentifier)
|
||||
> ,(isHostParam,isCsString)
|
||||
> ,(isHostParam,isUQIdentifier)
|
||||
> ,(isHostParam,isCQIdentifier)
|
||||
> ,(isIdentifier,isCsString)
|
||||
> ,(isIdentifier,isUQIdentifier)
|
||||
> ,(isIdentifier,isCQIdentifier)
|
||||
> ,(isWhitespace, isWhitespace)
|
||||
> ,(isIdentifier, isNumber)
|
||||
> ,(isHostParam, isNumber)
|
||||
|
@ -119,12 +123,17 @@ number number (todo: double check more carefully)
|
|||
> ]
|
||||
> isIdentifier (Identifier _) = True
|
||||
> isIdentifier _ = False
|
||||
> isQIdentifier (QIdentifier _) = True
|
||||
> isQIdentifier _ = False
|
||||
> isUQIdentifier (UQIdentifier _) = True
|
||||
> isUQIdentifier _ = False
|
||||
> isCsString (CSSqlString {}) = True
|
||||
> isDQIdentifier (QuotedIdentifier "\"" _ _) = True
|
||||
> isDQIdentifier _ = False
|
||||
> isCQIdentifier (QuotedIdentifier (x:_) _ _) | isAlpha x = True
|
||||
> isCQIdentifier _ = False
|
||||
> isCsString (SqlString (x:_) _ _) | isAlpha x = True
|
||||
> isCsString _ = False
|
||||
> isString (SqlString _ _ _) = True
|
||||
> isString _ = False
|
||||
> isNonCsString (SqlString [] _ _) = True
|
||||
> isNonCsString (SqlString (x:_) _ _) | not (isAlpha x) = True
|
||||
> isNonCsString _ = False
|
||||
> isEofLineComment (LineComment s) = last s /= '\n'
|
||||
> isEofLineComment _ = False
|
||||
> isLineComment (LineComment {}) = True
|
||||
|
@ -137,9 +146,6 @@ number number (todo: double check more carefully)
|
|||
> isWhitespace _ = False
|
||||
> isMinus (Symbol "-") = True
|
||||
> isMinus _ = False
|
||||
|
||||
> isString (SqlString _) = True
|
||||
> isString _ = False
|
||||
> symbolPair a b = ((==Symbol a), (==Symbol b))
|
||||
> listPred :: ((Token -> Bool),(Token -> Bool)) -> [Token] -> Bool
|
||||
> listPred _ [] = False
|
||||
|
|
|
@ -19,7 +19,7 @@ limit syntax
|
|||
|
||||
> backtickQuotes :: TestItem
|
||||
> backtickQuotes = Group "backtickQuotes" (map (uncurry (TestValueExpr mysql))
|
||||
> [("`test`", Iden [DQName "`" "`" "test"])
|
||||
> [("`test`", Iden [QuotedName "`" "`" "test"])
|
||||
> ]
|
||||
> ++ [ParseValueExprFails ansi2011 "`test`"]
|
||||
> )
|
||||
|
|
|
@ -506,17 +506,17 @@ Specify a non-null value.
|
|||
> characterStringLiterals = Group "character string literals"
|
||||
> $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [("'a regular string literal'"
|
||||
> ,StringLit "a regular string literal")
|
||||
> ,StringLit "'" "'" "a regular string literal")
|
||||
> ,("'something' ' some more' 'and more'"
|
||||
> ,StringLit "something some moreand more")
|
||||
> ,StringLit "'" "'" "something some moreand more")
|
||||
> ,("'something' \n ' some more' \t 'and more'"
|
||||
> ,StringLit "something some moreand more")
|
||||
> ,StringLit "'" "'" "something some moreand more")
|
||||
> ,("'something' -- a comment\n ' some more' /*another comment*/ 'and more'"
|
||||
> ,StringLit "something some moreand more")
|
||||
> ,StringLit "'" "'" "something some moreand more")
|
||||
> ,("'a quote: '', stuff'"
|
||||
> ,StringLit "a quote: ', stuff")
|
||||
> ,StringLit "'" "'" "a quote: ', stuff")
|
||||
> ,("''"
|
||||
> ,StringLit "")
|
||||
> ,StringLit "'" "'" "")
|
||||
|
||||
I'm not sure how this should work. Maybe the parser should reject non
|
||||
ascii characters in strings and identifiers unless the current SQL
|
||||
|
@ -533,8 +533,8 @@ character set allows them.
|
|||
> nationalCharacterStringLiterals :: TestItem
|
||||
> nationalCharacterStringLiterals = Group "national character string literals"
|
||||
> $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [("N'something'", CSStringLit "N" "something")
|
||||
> ,("n'something'", CSStringLit "n" "something")
|
||||
> [("N'something'", StringLit "N'" "'" "something")
|
||||
> ,("n'something'", StringLit "n'" "'" "something")
|
||||
> ]
|
||||
|
||||
<Unicode character string literal> ::=
|
||||
|
@ -550,11 +550,11 @@ character set allows them.
|
|||
> unicodeCharacterStringLiterals :: TestItem
|
||||
> unicodeCharacterStringLiterals = Group "unicode character string literals"
|
||||
> $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [("U&'something'", CSStringLit "U&" "something")
|
||||
> [("U&'something'", StringLit "U&'" "'" "something")
|
||||
> ,("u&'something' escape ="
|
||||
> ,Escape (CSStringLit "u&" "something") '=')
|
||||
> ,Escape (StringLit "u&'" "'" "something") '=')
|
||||
> ,("u&'something' uescape ="
|
||||
> ,UEscape (CSStringLit "u&" "something") '=')
|
||||
> ,UEscape (StringLit "u&'" "'" "something") '=')
|
||||
> ]
|
||||
|
||||
TODO: unicode escape
|
||||
|
@ -570,8 +570,8 @@ TODO: unicode escape
|
|||
> binaryStringLiterals = Group "binary string literals"
|
||||
> $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [--("B'101010'", CSStringLit "B" "101010")
|
||||
> ("X'7f7f7f'", CSStringLit "X" "7f7f7f")
|
||||
> ,("X'7f7f7f' escape z", Escape (CSStringLit "X" "7f7f7f") 'z')
|
||||
> ("X'7f7f7f'", StringLit "X'" "'" "7f7f7f")
|
||||
> ,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z')
|
||||
> ]
|
||||
|
||||
<signed numeric literal> ::= [ <sign> ] <unsigned numeric literal>
|
||||
|
@ -753,10 +753,10 @@ Specify names.
|
|||
> ,("t1",Iden [Name "t1"])
|
||||
> ,("a.b",Iden [Name "a", Name "b"])
|
||||
> ,("a.b.c",Iden [Name "a", Name "b", Name "c"])
|
||||
> ,("\"quoted iden\"", Iden [QName "quoted iden"])
|
||||
> ,("\"quoted \"\" iden\"", Iden [QName "quoted \" iden"])
|
||||
> ,("U&\"quoted iden\"", Iden [UQName "quoted iden"])
|
||||
> ,("U&\"quoted \"\" iden\"", Iden [UQName "quoted \" iden"])
|
||||
> ,("\"quoted iden\"", Iden [QuotedName "\"" "\"" "quoted iden"])
|
||||
> ,("\"quoted \"\" iden\"", Iden [QuotedName "\"" "\"" "quoted \" iden"])
|
||||
> ,("U&\"quoted iden\"", Iden [QuotedName "U&\"" "\"" "quoted iden"])
|
||||
> ,("U&\"quoted \"\" iden\"", Iden [QuotedName "U&\"" "\"" "quoted \" iden"])
|
||||
> ]
|
||||
|
||||
TODO: more identifiers, e.g. unicode escapes?, mixed quoted/unquoted
|
||||
|
@ -1100,8 +1100,8 @@ create a list of type name variations:
|
|||
> -- 1 with and without tz
|
||||
> ,("time with time zone"
|
||||
> ,TimeTypeName [Name "time"] Nothing True)
|
||||
> ,("timestamp(3) without time zone"
|
||||
> ,TimeTypeName [Name "timestamp"] (Just 3) False)
|
||||
> ,("datetime(3) without time zone"
|
||||
> ,TimeTypeName [Name "datetime"] (Just 3) False)
|
||||
> -- chars: (single/multiname) x prec x charset x collate
|
||||
> -- 1111
|
||||
> ,("char varying(5) character set something collate something_insensitive"
|
||||
|
@ -1199,7 +1199,7 @@ expression
|
|||
> [(ctn ++ " 'test'", TypedLit stn "test")
|
||||
> ]
|
||||
> makeCastTests (ctn, stn) =
|
||||
> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "test") stn)
|
||||
> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "'" "'" "test") stn)
|
||||
> ]
|
||||
> makeTests a = makeSimpleTests a ++ makeCastTests a
|
||||
|
||||
|
@ -1215,7 +1215,7 @@ Define a field of a row type.
|
|||
> fieldDefinition = Group "field definition"
|
||||
> $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [("cast('(1,2)' as row(a int,b char))"
|
||||
> ,Cast (StringLit "(1,2)")
|
||||
> ,Cast (StringLit "'" "'" "(1,2)")
|
||||
> $ RowTypeName [(Name "a", TypeName [Name "int"])
|
||||
> ,(Name "b", TypeName [Name "char"])])]
|
||||
|
||||
|
|
|
@ -34,9 +34,9 @@ Tests for parsing value expressions
|
|||
> ,("3e3", NumLit "3e3")
|
||||
> ,("3e+3", NumLit "3e+3")
|
||||
> ,("3e-3", NumLit "3e-3")
|
||||
> ,("'string'", StringLit "string")
|
||||
> ,("'string with a '' quote'", StringLit "string with a ' quote")
|
||||
> ,("'1'", StringLit "1")
|
||||
> ,("'string'", StringLit "'" "'" "string")
|
||||
> ,("'string with a '' quote'", StringLit "'" "'" "string with a ' quote")
|
||||
> ,("'1'", StringLit "'" "'" "1")
|
||||
> ,("interval '3' day"
|
||||
> ,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)
|
||||
> ,("interval '3' day (3)"
|
||||
|
@ -48,7 +48,7 @@ Tests for parsing value expressions
|
|||
> identifiers = Group "identifiers" $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [("iden1", Iden [Name "iden1"])
|
||||
> --,("t.a", Iden2 "t" "a")
|
||||
> ,("\"quoted identifier\"", Iden [QName "quoted identifier"])
|
||||
> ,("\"quoted identifier\"", Iden [QuotedName "\"" "\"" "quoted identifier"])
|
||||
> ]
|
||||
|
||||
> star :: TestItem
|
||||
|
@ -142,19 +142,19 @@ Tests for parsing value expressions
|
|||
> casts :: TestItem
|
||||
> casts = Group "operators" $ map (uncurry (TestValueExpr ansi2011))
|
||||
> [("cast('1' as int)"
|
||||
> ,Cast (StringLit "1") $ TypeName [Name "int"])
|
||||
> ,Cast (StringLit "'" "'" "1") $ TypeName [Name "int"])
|
||||
|
||||
> ,("int '3'"
|
||||
> ,TypedLit (TypeName [Name "int"]) "3")
|
||||
|
||||
> ,("cast('1' as double precision)"
|
||||
> ,Cast (StringLit "1") $ TypeName [Name "double precision"])
|
||||
> ,Cast (StringLit "'" "'" "1") $ TypeName [Name "double precision"])
|
||||
|
||||
> ,("cast('1' as float(8))"
|
||||
> ,Cast (StringLit "1") $ PrecTypeName [Name "float"] 8)
|
||||
> ,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name "float"] 8)
|
||||
|
||||
> ,("cast('1' as decimal(15,2))"
|
||||
> ,Cast (StringLit "1") $ PrecScaleTypeName [Name "decimal"] 15 2)
|
||||
> ,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name "decimal"] 15 2)
|
||||
|
||||
|
||||
> ,("double precision '3'"
|
||||
|
@ -283,43 +283,43 @@ target_string
|
|||
|
||||
> ,("trim(from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("both", StringLit " ")
|
||||
> [("both", StringLit "'" "'" " ")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
> ,("trim(leading from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("leading", StringLit " ")
|
||||
> [("leading", StringLit "'" "'" " ")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
> ,("trim(trailing from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("trailing", StringLit " ")
|
||||
> [("trailing", StringLit "'" "'" " ")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
> ,("trim(both from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("both", StringLit " ")
|
||||
> [("both", StringLit "'" "'" " ")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
|
||||
> ,("trim(leading 'x' from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("leading", StringLit "x")
|
||||
> [("leading", StringLit "'" "'" "x")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
> ,("trim(trailing 'y' from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("trailing", StringLit "y")
|
||||
> [("trailing", StringLit "'" "'" "y")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
> ,("trim(both 'z' from target_string collate C)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("both", StringLit "z")
|
||||
> [("both", StringLit "'" "'" "z")
|
||||
> ,("from", Collate (Iden [Name "target_string"]) [Name "C"])])
|
||||
|
||||
> ,("trim(leading from target_string)"
|
||||
> ,SpecialOpK [Name "trim"] Nothing
|
||||
> [("leading", StringLit " ")
|
||||
> [("leading", StringLit "'" "'" " ")
|
||||
> ,("from", Iden [Name "target_string"])])
|
||||
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue