starlitcanopy/simple-sql-parser
1
Fork 0
Code Activity

reorganise

Browse source 
move exe example to examples/
get rid of the second example
move tests to tests/
don't shadow show in Pretty
This commit is contained in:
Jake Wheat 2024-01-26 15:28:15 +00:00
parent fa5091ac80
commit 45669ed7d3
34 changed files with 51 additions and 63 deletions

18
tests/Language/SQL/SimpleSQL/CreateIndex.hs Normal file
View file

@ -0,0 +1,18 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.CreateIndex where
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestTypes
createIndexTests :: TestItem
createIndexTests = Group "create index tests"
[TestStatement ansi2011 "create index a on tbl(c1)"
$ CreateIndex False [nm "a"] [nm "tbl"] [nm "c1"]
,TestStatement ansi2011 "create index a.b on sc.tbl (c1, c2)"
$ CreateIndex False [nm "a", nm "b"] [nm "sc", nm "tbl"] [nm "c1", nm "c2"]
,TestStatement ansi2011 "create unique index a on tbl(c1)"
$ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]
]
where
nm = Name Nothing

28
tests/Language/SQL/SimpleSQL/CustomDialect.hs Normal file
View file

@ -0,0 +1,28 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where
import Language.SQL.SimpleSQL.TestTypes
customDialectTests :: TestItem
customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests
++ map (uncurry ParseScalarExprFails) failTests )
where
failTests = [(ansi2011,"SELECT DATE('2000-01-01')")
,(ansi2011,"SELECT DATE")
,(dateApp,"SELECT DATE")
,(dateIden,"SELECT DATE('2000-01-01')")
-- show this never being allowed as an alias
,(ansi2011,"SELECT a date")
,(dateApp,"SELECT a date")
,(dateIden,"SELECT a date")
]
passTests = [(ansi2011,"SELECT a b")
,(noDateKeyword,"SELECT DATE('2000-01-01')")
,(noDateKeyword,"SELECT DATE")
,(dateApp,"SELECT DATE('2000-01-01')")
,(dateIden,"SELECT DATE")
]
noDateKeyword = ansi2011 {diKeywords = filter (/="date") (diKeywords ansi2011)}
dateIden = ansi2011 {diIdentifierKeywords = "date" : diIdentifierKeywords ansi2011}
dateApp = ansi2011 {diAppKeywords = "date" : diAppKeywords ansi2011}

21
tests/Language/SQL/SimpleSQL/EmptyStatement.hs Normal file
View file

@ -0,0 +1,21 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.EmptyStatement where
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestTypes
emptyStatementTests :: TestItem
emptyStatementTests = Group "empty statement"
[ TestStatement ansi2011 ";" EmptyStatement
, TestStatements ansi2011 ";" [EmptyStatement]
, TestStatements ansi2011 ";;" [EmptyStatement, EmptyStatement]
, TestStatements ansi2011 ";;;" [EmptyStatement, EmptyStatement, EmptyStatement]
, TestStatement ansi2011 "/* comment */ ;" EmptyStatement
, TestStatements ansi2011 "" []
, TestStatements ansi2011 "/* comment */" []
, TestStatements ansi2011 "/* comment */ ;" [EmptyStatement]
, TestStatements ansi2011 "/* comment */ ; /* comment */ ;"
[EmptyStatement, EmptyStatement]
, TestStatements ansi2011 "/* comment */ ; /* comment */ ; /* comment */ ;"
[EmptyStatement, EmptyStatement, EmptyStatement]
]

156
tests/Language/SQL/SimpleSQL/ErrorMessages.hs Normal file
View file

@ -0,0 +1,156 @@
{-
Want to work on the error messages. Ultimately, parsec won't give the
best error message for a parser combinator library in haskell. Should
check out the alternatives such as polyparse and uu-parsing.
For now the plan is to try to get the best out of parsec. Skip heavy
work on this until the parser is more left factored?
Ideas:
1. generate large lists of invalid syntax
2. create table of the sql source and the error message
3. save these tables and compare from version to version. Want to
catch improvements and regressions and investigate. Have to do this
manually
= generating bad sql source
take good sql statements or expressions. Convert them into sequences
of tokens - want to preserve the whitespace and comments perfectly
here. Then modify these lists by either adding a token, removing a
token, or modifying a token (including creating bad tokens of raw
strings which don't represent anything than can be tokenized.
Now can see the error message for all of these bad strings. Probably
have to generate and prune this list manually in stages since there
will be too many.
Contexts:
another area to focus on is contexts: for instance, we have a set of
e.g. 1000 bad scalar expressions with error messages. Now can put
those bad scalar expressions into various contexts and see that the
error messages are still good.
plan:
1. create a list of all the value expression, with some variations for
each
2. manually create some error variations for each expression
3. create a renderer which will create a csv of the expressions and
the errors
this is to load as a spreadsheet to investigate more
4. create a renderer for the csv which will create a markdown file for
the website. this is to demonstrate the error messages in the
documentation
Then create some contexts for all of these: inside another value
expression, or inside a query expression. Do the same: render and
review the error messages.
Then, create some query expressions to focus on the non value
expression parts.
-}
module Language.SQL.SimpleSQL.ErrorMessages where
{-import Language.SQL.SimpleSQL.Parser
import Data.List
import Text.Groom
valueExpressions :: [String]
valueExpressions =
["10.."
,"..10"
,"10e1e2"
,"10e--3"
,"1a"
,"1%"
,"'b'ad'"
,"'bad"
,"bad'"
,"interval '5' ay"
,"interval '5' day (4.4)"
,"interval '5' day (a)"
,"intervala '5' day"
,"interval 'x' day (3"
,"interval 'x' day 3)"
,"1badiden"
,"$"
,"!"
,"*.a"
,"??"
,"3?"
,"?a"
,"row"
,"row 1,2"
,"row(1,2"
,"row 1,2)"
,"row(1 2)"
,"f("
,"f)"
,"f(a"
,"f a)"
,"f(a b)"
{-
TODO:
case
operators
-}
,"a + (b + c"
{-
casts
subqueries: + whole set of parentheses use
in list
'keyword' functions
aggregates
window functions
-}
]
queryExpressions :: [String]
queryExpressions =
map sl1 valueExpressions
++ map sl2 valueExpressions
++ map sl3 valueExpressions
++
["select a from t inner jin u"]
where
sl1 x = "select " ++ x ++ " from t"
sl2 x = "select " ++ x ++ ", y from t"
sl3 x = "select " ++ x ++ " fom t"
valExprs :: [String] -> [(String,String)]
valExprs = map parseOne
where
parseOne x = let p = parseValueExpr "" Nothing x
in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)
queryExprs :: [String] -> [(String,String)]
queryExprs = map parseOne
where
parseOne x = let p = parseQueryExpr "" Nothing x
in (x,either peFormattedError (\x -> "ERROR: parsed ok " ++ groom x) p)
pExprs :: [String] -> [String] -> String
pExprs x y =
let l = valExprs x ++ queryExprs y
in intercalate "\n\n\n\n" $ map (\(a,b) -> a ++ "\n" ++ b) l
-}

40
tests/Language/SQL/SimpleSQL/FullQueries.hs Normal file
View file

@ -0,0 +1,40 @@
-- Some tests for parsing full queries.
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
fullQueriesTests :: TestItem
fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))
[("select count(*) from t"
,toQueryExpr $ makeSelect
{msSelectList = [(App [Name Nothing "count"] [Star], Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}
)
,("select a, sum(c+d) as s\n\
\ from t,u\n\
\ where a > 5\n\
\ group by a\n\
\ having count(1) > 5\n\
\ order by s"
,toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "a"], Nothing)
,(App [Name Nothing "sum"]
[BinOp (Iden [Name Nothing "c"])
[Name Nothing "+"] (Iden [Name Nothing "d"])]
,Just $ Name Nothing "s")]
,msFrom = [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]]
,msWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")
,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
,msHaving = Just $ BinOp (App [Name Nothing "count"] [NumLit "1"])
[Name Nothing ">"] (NumLit "5")
,msOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault]
}
)
]

238
tests/Language/SQL/SimpleSQL/GroupBy.hs Normal file
View file

@ -0,0 +1,238 @@
-- Here are the tests for the group by component of query exprs
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.GroupBy (groupByTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
groupByTests :: TestItem
groupByTests = Group "groupByTests"
[simpleGroupBy
,newGroupBy
,randomGroupBy
]
simpleGroupBy :: TestItem
simpleGroupBy = Group "simpleGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
[("select a,sum(b) from t group by a"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)
,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
})
,("select a,b,sum(c) from t group by a,b"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)
,(Iden [Name Nothing "b"],Nothing)
,(App [Name Nothing "sum"] [Iden [Name Nothing "c"]],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]
,SimpleGroup $ Iden [Name Nothing "b"]]
})
]
{-
test the new group by (), grouping sets, cube and rollup syntax (not
sure which sql version they were introduced, 1999 or 2003 I think).
-}
newGroupBy :: TestItem
newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
[("select * from t group by ()", ms [GroupingParens []])
,("select * from t group by grouping sets ((), (a))"
,ms [GroupingSets [GroupingParens []
,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]])
,("select * from t group by cube(a,b)"
,ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])
,("select * from t group by rollup(a,b)"
,ms [Rollup [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]])
]
where
ms g = toQueryExpr $ makeSelect {msSelectList = [(Star,Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msGroupBy = g}
randomGroupBy :: TestItem
randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
["select * from t GROUP BY a"
,"select * from t GROUP BY GROUPING SETS((a))"
,"select * from t GROUP BY a,b,c"
,"select * from t GROUP BY GROUPING SETS((a,b,c))"
,"select * from t GROUP BY ROLLUP(a,b)"
,"select * from t GROUP BY GROUPING SETS((a,b),\n\
\(a),\n\
\() )"
,"select * from t GROUP BY ROLLUP(b,a)"
,"select * from t GROUP BY GROUPING SETS((b,a),\n\
\(b),\n\
\() )"
,"select * from t GROUP BY CUBE(a,b,c)"
,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
\(a,b),\n\
\(a,c),\n\
\(b,c),\n\
\(a),\n\
\(b),\n\
\(c),\n\
\() )"
,"select * from t GROUP BY ROLLUP(Province, County, City)"
,"select * from t GROUP BY ROLLUP(Province, (County, City))"
,"select * from t GROUP BY ROLLUP(Province, (County, City))"
,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
\(Province),\n\
\() )"
,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
\(Province, County),\n\
\(Province),\n\
\() )"
,"select * from t GROUP BY a, ROLLUP(b,c)"
,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
\(a,b),\n\
\(a) )"
,"select * from t GROUP BY a, b, ROLLUP(c,d)"
,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
\(a,b,c),\n\
\(a,b) )"
,"select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"
,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
\(a,b),\n\
\(a),\n\
\(b,c),\n\
\(b),\n\
\() )"
,"select * from t GROUP BY ROLLUP(a), CUBE(b,c)"
,"select * from t GROUP BY GROUPING SETS((a,b,c),\n\
\(a,b),\n\
\(a,c),\n\
\(a),\n\
\(b,c),\n\
\(b),\n\
\(c),\n\
\() )"
,"select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"
,"select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
\(a,b,c),\n\
\(a,b),\n\
\(a,c,d),\n\
\(a,c),\n\
\(a),\n\
\(b,c,d),\n\
\(b,c),\n\
\(b),\n\
\(c,d),\n\
\(c),\n\
\() )"
,"select * from t GROUP BY a, ROLLUP(a,b)"
,"select * from t GROUP BY GROUPING SETS((a,b),\n\
\(a) )"
,"select * from t GROUP BY Region,\n\
\ROLLUP(Sales_Person, WEEK(Sales_Date)),\n\
\CUBE(YEAR(Sales_Date), MONTH (Sales_Date))"
,"select * from t GROUP BY ROLLUP (Region, Sales_Person, WEEK(Sales_Date),\n\
\YEAR(Sales_Date), MONTH(Sales_Date) )"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\WHERE WEEK(SALES_DATE) = 13\n\
\GROUP BY WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON\n\
\ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\WHERE WEEK(SALES_DATE) = 13\n\
\GROUP BY GROUPING SETS ( (WEEK(SALES_DATE), SALES_PERSON),\n\
\(DAYOFWEEK(SALES_DATE), SALES_PERSON))\n\
\ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\WHERE WEEK(SALES_DATE) = 13\n\
\GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
\ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\SALES_PERSON, SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\WHERE WEEK(SALES_DATE) = 13\n\
\GROUP BY CUBE ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
\ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
,"SELECT SALES_PERSON,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
\SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\GROUP BY GROUPING SETS ( (SALES_PERSON, MONTH(SALES_DATE)),\n\
\()\n\
\)\n\
\ORDER BY SALES_PERSON, MONTH"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\GROUP BY ROLLUP ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) )\n\
\ORDER BY WEEK, DAY_WEEK"
,"SELECT MONTH(SALES_DATE) AS MONTH,\n\
\REGION,\n\
\SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\GROUP BY ROLLUP ( MONTH(SALES_DATE), REGION )\n\
\ORDER BY MONTH, REGION"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
\REGION,\n\
\SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
\GROUP BY GROUPING SETS ( ROLLUP( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE) ),\n\
\ROLLUP( MONTH(SALES_DATE), REGION ) )\n\
\ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
,"SELECT R1, R2,\n\
\WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
\REGION, SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\
\GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\
\DAYOFWEEK(SALES_DATE))),\n\
\(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
\ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
{-,"SELECT COALESCE(R1,R2) AS GROUP,\n\
\WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
\REGION, SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES,(VALUES('GROUP 1','GROUP 2')) AS X(R1,R2)\n\
\GROUP BY GROUPING SETS ((R1, ROLLUP(WEEK(SALES_DATE),\n\
\DAYOFWEEK(SALES_DATE))),\n\
\(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
\ORDER BY GROUP, WEEK, DAY_WEEK, MONTH, REGION"-}
-- as group - needs more subtle keyword blacklisting
-- decimal as a function not allowed due to the reserved keyword
-- handling: todo, review if this is ansi standard function or
-- if there are places where reserved keywords can still be used
,"SELECT MONTH(SALES_DATE) AS MONTH,\n\
\REGION,\n\
\SUM(SALES) AS UNITS_SOLD,\n\
\MAX(SALES) AS BEST_SALE,\n\
\CAST(ROUND(AVG(DECIMALx(SALES)),2) AS DECIMAL(5,2)) AS AVG_UNITS_SOLD\n\
\FROM SALES\n\
\GROUP BY CUBE(MONTH(SALES_DATE),REGION)\n\
\ORDER BY MONTH, REGION"
]

398
tests/Language/SQL/SimpleSQL/LexerTests.hs Normal file
View file

@ -0,0 +1,398 @@
-- Test for the lexer
{-
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 #-}
module Language.SQL.SimpleSQL.LexerTests (lexerTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Lex
(Token(..)
,tokenListWillPrintAndLex
)
import qualified Data.Text as T
import Data.Text (Text)
--import Debug.Trace
--import Data.Char (isAlpha)
-- import Data.List
lexerTests :: TestItem
lexerTests = Group "lexerTests" $
[bootstrapTests
,ansiLexerTests
,postgresLexerTests
,sqlServerLexerTests
,oracleLexerTests
,mySqlLexerTests
,odbcLexerTests]
-- quick sanity tests to see something working
bootstrapTests :: TestItem
bootstrapTests = Group "bootstrap tests" [Group "bootstrap tests" $
map (uncurry (LexTest ansi2011)) (
[("iden", [Identifier Nothing "iden"])
,("'string'", [SqlString "'" "'" "string"])
,(" ", [Whitespace " "])
,("\t ", [Whitespace "\t "])
,(" \n ", [Whitespace " \n "])
,("--", [LineComment "--"])
,("--\n", [LineComment "--\n"])
,("--stuff", [LineComment "--stuff"])
,("-- stuff", [LineComment "-- stuff"])
,("-- stuff\n", [LineComment "-- stuff\n"])
,("--\nstuff", [LineComment "--\n", Identifier Nothing "stuff"])
,("-- com \nstuff", [LineComment "-- com \n", Identifier Nothing "stuff"])
,("/*test1*/", [BlockComment "/*test1*/"])
,("/**/", [BlockComment "/**/"])
,("/***/", [BlockComment "/***/"])
,("/* * */", [BlockComment "/* * */"])
,("/*test*/", [BlockComment "/*test*/"])
,("/*te/*st*/", [BlockComment "/*te/*st*/"])
,("/*te*st*/", [BlockComment "/*te*st*/"])
,("/*lines\nmore lines*/", [BlockComment "/*lines\nmore lines*/"])
,("/*test1*/\n", [BlockComment "/*test1*/", Whitespace "\n"])
,("/*test1*/stuff", [BlockComment "/*test1*/", Identifier Nothing "stuff"])
,("1", [SqlNumber "1"])
,("42", [SqlNumber "42"])
-- have to fix the dialect handling in the tests
--,("$1", [PositionalArg 1])
--,("$200", [PositionalArg 200])
,(":test", [PrefixedVariable ':' "test"])
] ++ map (\a -> (a, [Symbol a])) (
["!=", "<>", ">=", "<=", "||"]
++ map T.singleton ("(),-+*/<>=." :: [Char])))]
ansiLexerTable :: [(Text,[Token])]
ansiLexerTable =
-- single char symbols
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
-- 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
-- host param
<> map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens
)
-- quoted identifiers with embedded double quotes
-- the lexer doesn't unescape the quotes
++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
-- strings
-- the lexer doesn't apply escapes at all
++ [("'string'", [SqlString "'" "'" "string"])
,("'normal '' quote'", [SqlString "'" "'" "normal '' quote"])
,("'normalendquote '''", [SqlString "'" "'" "normalendquote ''"])
,("'\n'", [SqlString "'" "'" "\n"])]
-- csstrings
++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))
["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
++ 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]))
["--", "-- ", "-- this is a comment", "-- line com\n"]
-- block comment
++ map (\c -> (c, [BlockComment c]))
["/**/", "/* */","/* this is a comment */"
,"/* 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)
| (s,t) <- ansiLexerTable
, (s1,t1) <- ansiLexerTable
, tokenListWillPrintAndLex ansi2011 $ t <> t1
]
,Group "ansiadhoclexertests" $
map (uncurry $ LexTest ansi2011)
[("", [])
,("-- line com\nstuff", [LineComment "-- line com\n",Identifier Nothing "stuff"])
] ++
[-- want to make sure this gives a parse error
LexFails ansi2011 "*/"
-- 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
,LexFails ansi2011 "|||"
,LexFails ansi2011 "||||"
,LexFails ansi2011 "|||||"
-- 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
,LexFails ansi2011 "12e3e4"
,LexFails ansi2011 "12e3e4"
,LexFails ansi2011 "12e3e4"
,LexFails ansi2011 "12e3.4"
,LexFails ansi2011 "12.4.5"
,LexFails ansi2011 "12.4e5.6"
,LexFails ansi2011 "12.4e5e7"]
]
{-
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.
-}
postgresLexerTable :: [(Text,[Token])]
postgresLexerTable =
-- single char symbols
map (\s -> (T.singleton s,[Symbol $ T.singleton s])) "+-^*/%~&|?<>[]=,;():"
-- 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
++ 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
-- host param
++ map (\i -> (T.cons ':' i, [PrefixedVariable ':' i])) idens
)
-- 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
++ map (\c -> (c <> "'test'", [SqlString (c <> "'") "'" "test"]))
["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
++ 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]))
["--", "-- ", "-- 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
-}
postgresShortOperatorTable :: [(Text,[Token])]
postgresShortOperatorTable =
[ (x, [Symbol x]) | x <- someValidPostgresOperators 2]
postgresExtraOperatorTable :: [(Text,[Token])]
postgresExtraOperatorTable =
[ (x, [Symbol x]) | x <- someValidPostgresOperators 4]
someValidPostgresOperators :: Int -> [Text]
someValidPostgresOperators l =
[ x
| n <- [1..l]
, x <- combos "+-*/<>=~!@#%^&|`?" n
, not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)
, not (T.last x `T.elem` "+-")
|| or (map (`T.elem` x) "~!@#%^&|`?")
]
{-
These are postgres operators, which if followed immediately by a + or
-, will lex as separate operators rather than one operator including
the + or -.
-}
somePostgresOpsWhichWontAddTrailingPlusMinus :: Int -> [Text]
somePostgresOpsWhichWontAddTrailingPlusMinus l =
[ x
| n <- [1..l]
, x <- combos "+-*/<>=" n
, not ("--" `T.isInfixOf` x || "/*" `T.isInfixOf` x || "*/" `T.isInfixOf` x)
, not (T.last x `T.elem` "+-")
]
postgresLexerTests :: TestItem
postgresLexerTests = Group "postgresLexerTests" $
[Group "postgres lexer token tests" $
[LexTest postgres s t | (s,t) <- postgresLexerTable]
,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)
| (s,t) <- postgresLexerTable ++ postgresShortOperatorTable
, (s1,t1) <- postgresLexerTable ++ postgresShortOperatorTable
, tokenListWillPrintAndLex postgres $ t ++ t1
]
,Group "generated postgres edgecase lexertests" $
[LexTest postgres s t
| (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
[LexFails postgres "*/"
,LexFails postgres ":::"
,LexFails postgres "::::"
,LexFails postgres ":::::"
,LexFails postgres "@*/"
,LexFails postgres "-*/"
,LexFails postgres "12e3e4"
,LexFails postgres "12e3e4"
,LexFails postgres "12e3e4"
,LexFails postgres "12e3.4"
,LexFails postgres "12.4.5"
,LexFails postgres "12.4e5.6"
,LexFails postgres "12.4e5e7"
-- special case allow this to lex to 1 .. 2
-- this is for 'for loops' in plpgsql
,LexTest postgres "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]]
]
where
edgeCaseCommentOps =
[ (x <> "/*<test*/", [Symbol x, BlockComment "/*<test*/"])
| x <- eccops
, not (T.last x == '*')
] ++
[ (x <> "--<test", [Symbol x, LineComment "--<test"])
| x <- eccops
, not (T.last x == '-')
]
eccops = someValidPostgresOperators 2
edgeCasePlusMinusOps = concat
[ [ (x <> "+", [Symbol x, Symbol "+"])
, (x <> "-", [Symbol x, Symbol "-"]) ]
| x <- somePostgresOpsWhichWontAddTrailingPlusMinus 2
]
edgeCasePlusMinusComments =
[("---", [LineComment "---"])
,("+--", [Symbol "+", LineComment "--"])
,("-/**/", [Symbol "-", BlockComment "/**/"])
,("+/**/", [Symbol "+", BlockComment "/**/"])
]
sqlServerLexerTests :: TestItem
sqlServerLexerTests = Group "sqlServerLexTests" $
[ LexTest sqlserver s t | (s,t) <-
[("@variable", [(PrefixedVariable '@' "variable")])
,("#variable", [(PrefixedVariable '#' "variable")])
,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])
]]
oracleLexerTests :: TestItem
oracleLexerTests = Group "oracleLexTests" $
[] -- nothing oracle specific atm
mySqlLexerTests :: TestItem
mySqlLexerTests = Group "mySqlLexerTests" $
[ LexTest mysql s t | (s,t) <-
[("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])
]
]
odbcLexerTests :: TestItem
odbcLexerTests = Group "odbcLexTests" $
[ LexTest sqlserver {diOdbc = True} s t | (s,t) <-
[("{}", [Symbol "{", Symbol "}"])
]]
++ [LexFails sqlserver {diOdbc = False} "{"
,LexFails sqlserver {diOdbc = False} "}"]
combos :: [Char] -> Int -> [Text]
combos _ 0 = [T.empty]
combos l n = [ T.cons x tl | x <- l, tl <- combos l (n - 1) ]

43
tests/Language/SQL/SimpleSQL/MySQL.hs Normal file
View file

@ -0,0 +1,43 @@
-- Tests for mysql dialect parsing
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.MySQL (mySQLTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
mySQLTests :: TestItem
mySQLTests = Group "mysql dialect"
[backtickQuotes
,limit]
{-
backtick quotes
limit syntax
[LIMIT {[offset,] row_count | row_count OFFSET offset}]
-}
backtickQuotes :: TestItem
backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))
[("`test`", Iden [Name (Just ("`","`")) "test"])
]
++ [ParseScalarExprFails ansi2011 "`test`"]
)
limit :: TestItem
limit = Group "queries" ( map (uncurry (TestQueryExpr mysql))
[("select * from t limit 5"
,toQueryExpr $ sel {msFetchFirst = Just (NumLit "5")}
)
]
++ [ParseQueryExprFails mysql "select a from t fetch next 10 rows only;"
,ParseQueryExprFails ansi2011 "select * from t limit 5"]
)
where
sel = makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}

53
tests/Language/SQL/SimpleSQL/Odbc.hs Normal file
View file

@ -0,0 +1,53 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.Odbc (odbcTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
odbcTests :: TestItem
odbcTests = Group "odbc" [
Group "datetime" [
e "{d '2000-01-01'}" (OdbcLiteral OLDate "2000-01-01")
,e "{t '12:00:01.1'}" (OdbcLiteral OLTime "12:00:01.1")
,e "{ts '2000-01-01 12:00:01.1'}"
(OdbcLiteral OLTimestamp "2000-01-01 12:00:01.1")
]
,Group "functions" [
e "{fn CHARACTER_LENGTH(string_exp)}"
$ OdbcFunc (ap "CHARACTER_LENGTH" [iden "string_exp"])
,e "{fn EXTRACT(day from t)}"
$ OdbcFunc (SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
,e "{fn now()}"
$ OdbcFunc (ap "now" [])
,e "{fn CONVERT('2000-01-01', SQL_DATE)}"
$ OdbcFunc (ap "CONVERT"
[StringLit "'" "'" "2000-01-01"
,iden "SQL_DATE"])
,e "{fn CONVERT({fn CURDATE()}, SQL_DATE)}"
$ OdbcFunc (ap "CONVERT"
[OdbcFunc (ap "CURDATE" [])
,iden "SQL_DATE"])
]
,Group "outer join" [
TestQueryExpr ansi2011 {diOdbc=True}
"select * from {oj t1 left outer join t2 on expr}"
$ toQueryExpr $ makeSelect
{msSelectList = [(Star,Nothing)]
,msFrom = [TROdbc $ TRJoin (TRSimple [Name Nothing "t1"]) False JLeft (TRSimple [Name Nothing "t2"])
(Just $ JoinOn $ Iden [Name Nothing "expr"])]}]
,Group "check parsing bugs" [
TestQueryExpr ansi2011 {diOdbc=True}
"select {fn CONVERT(cint,SQL_BIGINT)} from t;"
$ toQueryExpr $ makeSelect
{msSelectList = [(OdbcFunc (ap "CONVERT"
[iden "cint"
,iden "SQL_BIGINT"]), Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]}]
]
where
e = TestScalarExpr ansi2011 {diOdbc = True}
--tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}
ap n = App [Name Nothing n]
iden n = Iden [Name Nothing n]

30
tests/Language/SQL/SimpleSQL/Oracle.hs Normal file
View file

@ -0,0 +1,30 @@
-- Tests for oracle dialect parsing
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.Oracle (oracleTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
oracleTests :: TestItem
oracleTests = Group "oracle dialect"
[oracleLobUnits]
oracleLobUnits :: TestItem
oracleLobUnits = Group "oracleLobUnits" (map (uncurry (TestScalarExpr oracle))
[("cast (a as varchar2(3 char))"
,Cast (Iden [Name Nothing "a"]) (
PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters)))
,("cast (a as varchar2(3 byte))"
,Cast (Iden [Name Nothing "a"]) (
PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecOctets)))
]
++ [TestStatement oracle
"create table t (a varchar2(55 BYTE));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a")
(PrecLengthTypeName [Name Nothing "varchar2"] 55 Nothing (Just PrecOctets))
Nothing []]]
)

279
tests/Language/SQL/SimpleSQL/Postgres.hs Normal file
View file

@ -0,0 +1,279 @@
{-
Here are some tests taken from the SQL in the postgres manual. Almost
all of the postgres specific syntax has been skipped, this can be
revisited when the dialect support is added.
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.Postgres (postgresTests) where
import Language.SQL.SimpleSQL.TestTypes
postgresTests :: TestItem
postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)
{-
lexical syntax section
TODO: get all the commented out tests working
-}
[-- "SELECT 'foo'\n\
-- \'bar';" -- this should parse as select 'foobar'
-- ,
"SELECT name, (SELECT max(pop) FROM cities\n\
\ WHERE cities.state = states.name)\n\
\ FROM states;"
,"SELECT ROW(1,2.5,'this is a test');"
,"SELECT ROW(t.*, 42) FROM t;"
,"SELECT ROW(t.f1, t.f2, 42) FROM t;"
,"SELECT getf1(CAST(ROW(11,'this is a test',2.5) AS myrowtype));"
,"SELECT ROW(1,2.5,'this is a test') = ROW(1, 3, 'not the same');"
-- table is a reservered keyword?
--,"SELECT ROW(table.*) IS NULL FROM table;"
,"SELECT ROW(tablex.*) IS NULL FROM tablex;"
,"SELECT true OR somefunc();"
,"SELECT somefunc() OR true;"
-- queries section
,"SELECT * FROM t1 CROSS JOIN t2;"
,"SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"
,"SELECT * FROM t1 INNER JOIN t2 USING (num);"
,"SELECT * FROM t1 NATURAL INNER JOIN t2;"
,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"
,"SELECT * FROM t1 LEFT JOIN t2 USING (num);"
,"SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"
,"SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"
,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"
,"SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"
,"SELECT * FROM some_very_long_table_name s\n\
\JOIN another_fairly_long_name a ON s.id = a.num;"
,"SELECT * FROM people AS mother JOIN people AS child\n\
\ ON mother.id = child.mother_id;"
,"SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"
,"SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"
,"SELECT * FROM getfoo(1) AS t1;"
,"SELECT * FROM foo\n\
\ WHERE foosubid IN (\n\
\ SELECT foosubid\n\
\ FROM getfoo(foo.fooid) z\n\
\ WHERE z.fooid = foo.fooid\n\
\ );"
{-,"SELECT *\n\
\ FROM dblink('dbname=mydb', 'SELECT proname, prosrc FROM pg_proc')\n\
\ AS t1(proname name, prosrc text)\n\
\ WHERE proname LIKE 'bytea%';"-} -- types in the alias??
,"SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"
,"SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"
{-,"SELECT p1.id, p2.id, v1, v2\n\
\FROM polygons p1, polygons p2,\n\
\ LATERAL vertices(p1.poly) v1,\n\
\ LATERAL vertices(p2.poly) v2\n\
\WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-} -- <-> operator?
{-,"SELECT p1.id, p2.id, v1, v2\n\
\FROM polygons p1 CROSS JOIN LATERAL vertices(p1.poly) v1,\n\
\ polygons p2 CROSS JOIN LATERAL vertices(p2.poly) v2\n\
\WHERE (v1 <-> v2) < 10 AND p1.id != p2.id;"-}
,"SELECT m.name\n\
\FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true\n\
\WHERE pname IS NULL;"
,"SELECT * FROM fdt WHERE c1 > 5"
,"SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"
,"SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"
,"SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"
,"SELECT * FROM fdt WHERE c1 BETWEEN \n\
\ (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10) AND 100"
,"SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"
,"SELECT * FROM test1;"
,"SELECT x FROM test1 GROUP BY x;"
,"SELECT x, sum(y) FROM test1 GROUP BY x;"
-- s.date changed to s.datex because of reserved keyword
-- handling, not sure if this is correct or not for ansi sql
,"SELECT product_id, p.name, (sum(s.units) * p.price) AS sales\n\
\ FROM products p LEFT JOIN sales s USING (product_id)\n\
\ GROUP BY product_id, p.name, p.price;"
,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"
,"SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"
,"SELECT product_id, p.name, (sum(s.units) * (p.price - p.cost)) AS profit\n\
\ FROM products p LEFT JOIN sales s USING (product_id)\n\
\ WHERE s.datex > CURRENT_DATE - INTERVAL '4 weeks'\n\
\ GROUP BY product_id, p.name, p.price, p.cost\n\
\ HAVING sum(p.price * s.units) > 5000;"
,"SELECT a, b, c FROM t"
,"SELECT tbl1.a, tbl2.a, tbl1.b FROM t"
,"SELECT tbl1.*, tbl2.a FROM t"
,"SELECT a AS value, b + c AS sum FROM t"
,"SELECT a \"value\", b + c AS sum FROM t"
,"SELECT DISTINCT select_list t"
,"VALUES (1, 'one'), (2, 'two'), (3, 'three');"
,"SELECT 1 AS column1, 'one' AS column2\n\
\UNION ALL\n\
\SELECT 2, 'two'\n\
\UNION ALL\n\
\SELECT 3, 'three';"
,"SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"
,"WITH regional_sales AS (\n\
\ SELECT region, SUM(amount) AS total_sales\n\
\ FROM orders\n\
\ GROUP BY region\n\
\ ), top_regions AS (\n\
\ SELECT region\n\
\ FROM regional_sales\n\
\ WHERE total_sales > (SELECT SUM(total_sales)/10 FROM regional_sales)\n\
\ )\n\
\SELECT region,\n\
\ product,\n\
\ SUM(quantity) AS product_units,\n\
\ SUM(amount) AS product_sales\n\
\FROM orders\n\
\WHERE region IN (SELECT region FROM top_regions)\n\
\GROUP BY region, product;"
,"WITH RECURSIVE t(n) AS (\n\
\ VALUES (1)\n\
\ UNION ALL\n\
\ SELECT n+1 FROM t WHERE n < 100\n\
\)\n\
\SELECT sum(n) FROM t"
,"WITH RECURSIVE included_parts(sub_part, part, quantity) AS (\n\
\ SELECT sub_part, part, quantity FROM parts WHERE part = 'our_product'\n\
\ UNION ALL\n\
\ SELECT p.sub_part, p.part, p.quantity\n\
\ FROM included_parts pr, parts p\n\
\ WHERE p.part = pr.sub_part\n\
\ )\n\
\SELECT sub_part, SUM(quantity) as total_quantity\n\
\FROM included_parts\n\
\GROUP BY sub_part"
,"WITH RECURSIVE search_graph(id, link, data, depth) AS (\n\
\ SELECT g.id, g.link, g.data, 1\n\
\ FROM graph g\n\
\ UNION ALL\n\
\ SELECT g.id, g.link, g.data, sg.depth + 1\n\
\ FROM graph g, search_graph sg\n\
\ WHERE g.id = sg.link\n\
\)\n\
\SELECT * FROM search_graph;"
{-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
\ SELECT g.id, g.link, g.data, 1,\n\
\ ARRAY[g.id],\n\
\ false\n\
\ FROM graph g\n\
\ UNION ALL\n\
\ SELECT g.id, g.link, g.data, sg.depth + 1,\n\
\ path || g.id,\n\
\ g.id = ANY(path)\n\
\ FROM graph g, search_graph sg\n\
\ WHERE g.id = sg.link AND NOT cycle\n\
\)\n\
\SELECT * FROM search_graph;"-} -- ARRAY
{-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
\ SELECT g.id, g.link, g.data, 1,\n\
\ ARRAY[ROW(g.f1, g.f2)],\n\
\ false\n\
\ FROM graph g\n\
\ UNION ALL\n\
\ SELECT g.id, g.link, g.data, sg.depth + 1,\n\
\ path || ROW(g.f1, g.f2),\n\
\ ROW(g.f1, g.f2) = ANY(path)\n\
\ FROM graph g, search_graph sg\n\
\ WHERE g.id = sg.link AND NOT cycle\n\
\)\n\
\SELECT * FROM search_graph;"-} -- ARRAY
,"WITH RECURSIVE t(n) AS (\n\
\ SELECT 1\n\
\ UNION ALL\n\
\ SELECT n+1 FROM t\n\
\)\n\
\SELECT n FROM t --LIMIT 100;" -- limit is not standard
-- select page reference
,"SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\
\ FROM distributors d, films f\n\
\ WHERE f.did = d.did"
,"SELECT kind, sum(len) AS total\n\
\ FROM films\n\
\ GROUP BY kind\n\
\ HAVING sum(len) < interval '5 hours';"
,"SELECT * FROM distributors ORDER BY name;"
,"SELECT * FROM distributors ORDER BY 2;"
,"SELECT distributors.name\n\
\ FROM distributors\n\
\ WHERE distributors.name LIKE 'W%'\n\
\UNION\n\
\SELECT actors.name\n\
\ FROM actors\n\
\ WHERE actors.name LIKE 'W%';"
,"WITH t AS (\n\
\ SELECT random() as x FROM generate_series(1, 3)\n\
\ )\n\
\SELECT * FROM t\n\
\UNION ALL\n\
\SELECT * FROM t"
,"WITH RECURSIVE employee_recursive(distance, employee_name, manager_name) AS (\n\
\ SELECT 1, employee_name, manager_name\n\
\ FROM employee\n\
\ WHERE manager_name = 'Mary'\n\
\ UNION ALL\n\
\ SELECT er.distance + 1, e.employee_name, e.manager_name\n\
\ FROM employee_recursive er, employee e\n\
\ WHERE er.employee_name = e.manager_name\n\
\ )\n\
\SELECT distance, employee_name FROM employee_recursive;"
,"SELECT m.name AS mname, pname\n\
\FROM manufacturers m, LATERAL get_product_names(m.id) pname;"
,"SELECT m.name AS mname, pname\n\
\FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"
,"SELECT 2+2;"
-- simple-sql-parser doesn't support where without from
-- this can be added for the postgres dialect when it is written
--,"SELECT distributors.* WHERE distributors.name = 'Westward';"
]

209
tests/Language/SQL/SimpleSQL/QueryExprComponents.hs Normal file
View file

@ -0,0 +1,209 @@
{-
These are the tests for the query expression components apart from the
table refs which are in a separate file.
These are a few misc tests which don't fit anywhere else.
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
queryExprComponentTests :: TestItem
queryExprComponentTests = Group "queryExprComponentTests"
[duplicates
,selectLists
,whereClause
,having
,orderBy
,offsetFetch
,combos
,withQueries
,values
,tables
]
duplicates :: TestItem
duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))
[("select a from t" ,ms SQDefault)
,("select all a from t" ,ms All)
,("select distinct a from t", ms Distinct)
]
where
ms d = toQueryExpr $ makeSelect
{msSetQuantifier = d
,msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]}
selectLists :: TestItem
selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))
[("select 1",
toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]})
,("select a"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]})
,("select a,b"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)
,(Iden [Name Nothing "b"],Nothing)]})
,("select 1+2,3+4"
,toQueryExpr $ makeSelect {msSelectList =
[(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)
,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),Nothing)]})
,("select a as a, /*comment*/ b as b"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")
,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})
,("select a a, b b"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"], Just $ Name Nothing "a")
,(Iden [Name Nothing "b"], Just $ Name Nothing "b")]})
,("select a + b * c"
,toQueryExpr $ makeSelect {msSelectList =
[(BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]
(BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"]))
,Nothing)]})
]
whereClause :: TestItem
whereClause = Group "whereClause" $ map (uncurry (TestQueryExpr ansi2011))
[("select a from t where a = 5"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msWhere = Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "5")})
]
having :: TestItem
having = Group "having" $ map (uncurry (TestQueryExpr ansi2011))
[("select a,sum(b) from t group by a having sum(b) > 5"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)
,(App [Name Nothing "sum"] [Iden [Name Nothing "b"]],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msGroupBy = [SimpleGroup $ Iden [Name Nothing "a"]]
,msHaving = Just $ BinOp (App [Name Nothing "sum"] [Iden [Name Nothing "b"]])
[Name Nothing ">"] (NumLit "5")
})
]
orderBy :: TestItem
orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))
[("select a from t order by a"
,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault])
,("select a from t order by a, b"
,ms [SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault
,SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault])
,("select a from t order by a asc"
,ms [SortSpec (Iden [Name Nothing "a"]) Asc NullsOrderDefault])
,("select a from t order by a desc, b desc"
,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsOrderDefault
,SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault])
,("select a from t order by a desc nulls first, b desc nulls last"
,ms [SortSpec (Iden [Name Nothing "a"]) Desc NullsFirst
,SortSpec (Iden [Name Nothing "b"]) Desc NullsLast])
]
where
ms o = toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msOrderBy = o}
offsetFetch :: TestItem
offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))
[-- ansi standard
("select a from t offset 5 rows fetch next 10 rows only"
,ms (Just $ NumLit "5") (Just $ NumLit "10"))
,("select a from t offset 5 rows;"
,ms (Just $ NumLit "5") Nothing)
,("select a from t fetch next 10 row only;"
,ms Nothing (Just $ NumLit "10"))
,("select a from t offset 5 row fetch first 10 row only"
,ms (Just $ NumLit "5") (Just $ NumLit "10"))
-- postgres: disabled, will add back when postgres
-- dialect is added
--,("select a from t limit 10 offset 5"
-- ,ms (Just $ NumLit "5") (Just $ NumLit "10"))
]
where
ms o l = toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msOffset = o
,msFetchFirst = l}
combos :: TestItem
combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))
[("select a from t union select b from u"
,QueryExprSetOp mst Union SQDefault Respectively msu)
,("select a from t intersect select b from u"
,QueryExprSetOp mst Intersect SQDefault Respectively msu)
,("select a from t except all select b from u"
,QueryExprSetOp mst Except All Respectively msu)
,("select a from t union distinct corresponding \
\select b from u"
,QueryExprSetOp mst Union Distinct Corresponding msu)
,("select a from t union select a from t union select a from t"
,QueryExprSetOp (QueryExprSetOp mst Union SQDefault Respectively mst)
Union SQDefault Respectively mst)
]
where
mst = toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]}
msu = toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "b"],Nothing)]
,msFrom = [TRSimple [Name Nothing "u"]]}
withQueries :: TestItem
withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))
[("with u as (select a from t) select a from u"
,With False [(Alias (Name Nothing "u") Nothing, ms1)] ms2)
,("with u(b) as (select a from t) select a from u"
,With False [(Alias (Name Nothing "u") (Just [Name Nothing "b"]), ms1)] ms2)
,("with x as (select a from t),\n\
\ u as (select a from x)\n\
\select a from u"
,With False [(Alias (Name Nothing "x") Nothing, ms1), (Alias (Name Nothing "u") Nothing,ms3)] ms2)
,("with recursive u as (select a from t) select a from u"
,With True [(Alias (Name Nothing "u") Nothing, ms1)] ms2)
]
where
ms c t = toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing c],Nothing)]
,msFrom = [TRSimple [Name Nothing t]]}
ms1 = ms "a" "t"
ms2 = ms "a" "u"
ms3 = ms "a" "x"
values :: TestItem
values = Group "values" $ map (uncurry (TestQueryExpr ansi2011))
[("values (1,2),(3,4)"
,Values [[NumLit "1", NumLit "2"]
,[NumLit "3", NumLit "4"]])
]
tables :: TestItem
tables = Group "tables" $ map (uncurry (TestQueryExpr ansi2011))
[("table tbl", Table [Name Nothing "tbl"])
]

27
tests/Language/SQL/SimpleSQL/QueryExprs.hs Normal file
View file

@ -0,0 +1,27 @@
{-
These are the tests for the queryExprs parsing which parses multiple
query expressions from one string.
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.QueryExprs (queryExprsTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
queryExprsTests :: TestItem
queryExprsTests = Group "query exprs" $ map (uncurry (TestStatements ansi2011))
[("select 1",[ms])
,("select 1;",[ms])
,("select 1;select 1",[ms,ms])
,(" select 1;select 1; ",[ms,ms])
,("SELECT CURRENT_TIMESTAMP;"
,[SelectStatement $ toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}])
,("SELECT \"CURRENT_TIMESTAMP\";"
,[SelectStatement $ toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}])
]
where
ms = SelectStatement $ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]}

330
tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs Normal file
View file

@ -0,0 +1,330 @@
{-
Section 12 in Foundation
grant, etc
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
sql2011AccessControlTests :: TestItem
sql2011AccessControlTests = Group "sql 2011 access control tests" [
{-
12 Access control
12.1 <grant statement>
<grant statement> ::=
<grant privilege statement>
| <grant role statement>
12.2 <grant privilege statement>
<grant privilege statement> ::=
GRANT <privileges> TO <grantee> [ { <comma> <grantee> }... ]
[ WITH HIERARCHY OPTION ]
[ WITH GRANT OPTION ]
[ GRANTED BY <grantor> ]
12.3 <privileges>
<privileges> ::=
<object privileges> ON <object name>
<object name> ::=
[ TABLE ] <table name>
| DOMAIN <domain name>
| COLLATION <collation name>
| CHARACTER SET <character set name>
| TRANSLATION <transliteration name>
| TYPE <schema-resolved user-defined type name>
| SEQUENCE <sequence generator name>
| <specific routine designator>
<object privileges> ::=
ALL PRIVILEGES
| <action> [ { <comma> <action> }... ]
<action> ::=
SELECT
| SELECT <left paren> <privilege column list> <right paren>
| SELECT <left paren> <privilege method list> <right paren>
| DELETE
| INSERT [ <left paren> <privilege column list> <right paren> ]
| UPDATE [ <left paren> <privilege column list> <right paren> ]
| REFERENCES [ <left paren> <privilege column list> <right paren> ]
| USAGE
| TRIGGER
| UNDER
| EXECUTE
<privilege method list> ::=
<specific routine designator> [ { <comma> <specific routine designator> }... ]
<privilege column list> ::=
<column name list>
<grantee> ::=
PUBLIC
| <authorization identifier>
<grantor> ::=
CURRENT_USER
| CURRENT_ROLE
-}
(TestStatement ansi2011
"grant all privileges on tbl1 to role1"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant all privileges on tbl1 to role1,role2"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)
,(TestStatement ansi2011
"grant all privileges on tbl1 to role1 with grant option"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1"] WithGrantOption)
,(TestStatement ansi2011
"grant all privileges on table tbl1 to role1"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant all privileges on domain mydom to role1"
$ GrantPrivilege [PrivAll]
(PrivDomain [Name Nothing "mydom"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant all privileges on type t1 to role1"
$ GrantPrivilege [PrivAll]
(PrivType [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant all privileges on sequence s1 to role1"
$ GrantPrivilege [PrivAll]
(PrivSequence [Name Nothing "s1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant select on table t1 to role1"
$ GrantPrivilege [PrivSelect []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant select(a,b) on table t1 to role1"
$ GrantPrivilege [PrivSelect [Name Nothing "a", Name Nothing "b"]]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant delete on table t1 to role1"
$ GrantPrivilege [PrivDelete]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant insert on table t1 to role1"
$ GrantPrivilege [PrivInsert []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant insert(a,b) on table t1 to role1"
$ GrantPrivilege [PrivInsert [Name Nothing "a", Name Nothing "b"]]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant update on table t1 to role1"
$ GrantPrivilege [PrivUpdate []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant update(a,b) on table t1 to role1"
$ GrantPrivilege [PrivUpdate [Name Nothing "a", Name Nothing "b"]]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant references on table t1 to role1"
$ GrantPrivilege [PrivReferences []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant references(a,b) on table t1 to role1"
$ GrantPrivilege [PrivReferences [Name Nothing "a", Name Nothing "b"]]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant usage on table t1 to role1"
$ GrantPrivilege [PrivUsage]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant trigger on table t1 to role1"
$ GrantPrivilege [PrivTrigger]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant execute on specific function f to role1"
$ GrantPrivilege [PrivExecute]
(PrivFunction [Name Nothing "f"])
[Name Nothing "role1"] WithoutGrantOption)
,(TestStatement ansi2011
"grant select,delete on table t1 to role1"
$ GrantPrivilege [PrivSelect [], PrivDelete]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
{-
skipping for now:
what is 'under' action?
collation, character set, translation, member thing, methods
for review
some pretty big things missing in the standard:
schema, database
functions, etc., by argument types since they can be overloaded
12.4 <role definition>
<role definition> ::=
CREATE ROLE <role name> [ WITH ADMIN <grantor> ]
-}
,(TestStatement ansi2011
"create role rolee"
$ CreateRole (Name Nothing "rolee"))
{-
12.5 <grant role statement>
<grant role statement> ::=
GRANT <role granted> [ { <comma> <role granted> }... ]
TO <grantee> [ { <comma> <grantee> }... ]
[ WITH ADMIN OPTION ]
[ GRANTED BY <grantor> ]
<role granted> ::=
<role name>
-}
,(TestStatement ansi2011
"grant role1 to public"
$ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)
,(TestStatement ansi2011
"grant role1,role2 to role3,role4"
$ GrantRole [Name Nothing "role1",Name Nothing "role2"]
[Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)
,(TestStatement ansi2011
"grant role1 to role3 with admin option"
$ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)
{-
12.6 <drop role statement>
<drop role statement> ::=
DROP ROLE <role name>
-}
,(TestStatement ansi2011
"drop role rolee"
$ DropRole (Name Nothing "rolee"))
{-
12.7 <revoke statement>
<revoke statement> ::=
<revoke privilege statement>
| <revoke role statement>
<revoke privilege statement> ::=
REVOKE [ <revoke option extension> ] <privileges>
FROM <grantee> [ { <comma> <grantee> }... ]
[ GRANTED BY <grantor> ]
<drop behavior>
<revoke option extension> ::=
GRANT OPTION FOR
| HIERARCHY OPTION FOR
-}
,(TestStatement ansi2011
"revoke select on t1 from role1"
$ RevokePrivilege NoGrantOptionFor [PrivSelect []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] DefaultDropBehaviour)
,(TestStatement ansi2011
"revoke grant option for select on t1 from role1,role2 cascade"
$ RevokePrivilege GrantOptionFor [PrivSelect []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1",Name Nothing "role2"] Cascade)
{-
<revoke role statement> ::=
REVOKE [ ADMIN OPTION FOR ] <role revoked> [ { <comma> <role revoked> }... ]
FROM <grantee> [ { <comma> <grantee> }... ]
[ GRANTED BY <grantor> ]
<drop behavior>
<role revoked> ::=
<role name>
-}
,(TestStatement ansi2011
"revoke role1 from role2"
$ RevokeRole NoAdminOptionFor [Name Nothing "role1"]
[Name Nothing "role2"] DefaultDropBehaviour)
,(TestStatement ansi2011
"revoke role1,role2 from role3,role4"
$ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]
[Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)
,(TestStatement ansi2011
"revoke admin option for role1 from role2 cascade"
$ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade)
]

234
tests/Language/SQL/SimpleSQL/SQL2011Bits.hs Normal file
View file

@ -0,0 +1,234 @@
{-
Sections 17 and 19 in Foundation
This module covers the tests for transaction management (begin,
commit, savepoint, etc.), and session management (set).
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
sql2011BitsTests :: TestItem
sql2011BitsTests = Group "sql 2011 bits tests" [
{-
17 Transaction management
17.1 <start transaction statement>
<start transaction statement> ::=
START TRANSACTION [ <transaction characteristics> ]
BEGIN is not in the standard!
-}
(TestStatement ansi2011
"start transaction"
$ StartTransaction)
{-
17.2 <set transaction statement>
<set transaction statement> ::=
SET [ LOCAL ] TRANSACTION <transaction characteristics>
17.3 <transaction characteristics>
<transaction characteristics> ::=
[ <transaction mode> [ { <comma> <transaction mode> }... ] ]
<transaction mode> ::=
<isolation level>
| <transaction access mode>
| <diagnostics size>
<transaction access mode> ::=
READ ONLY
| READ WRITE
<isolation level> ::=
ISOLATION LEVEL <level of isolation>
<level of isolation> ::=
READ UNCOMMITTED
| READ COMMITTED
| REPEATABLE READ
| SERIALIZABLE
<diagnostics size> ::=
DIAGNOSTICS SIZE <number of conditions>
<number of conditions> ::=
<simple value specification>
17.4 <set constraints mode statement>
<set constraints mode statement> ::=
SET CONSTRAINTS <constraint name list> { DEFERRED | IMMEDIATE }
<constraint name list> ::=
ALL
| <constraint name> [ { <comma> <constraint name> }... ]
17.5 <savepoint statement>
<savepoint statement> ::=
SAVEPOINT <savepoint specifier>
<savepoint specifier> ::=
<savepoint name>
-}
,(TestStatement ansi2011
"savepoint difficult_bit"
$ Savepoint $ Name Nothing "difficult_bit")
{-
17.6 <release savepoint statement>
<release savepoint statement> ::=
RELEASE SAVEPOINT <savepoint specifier>
-}
,(TestStatement ansi2011
"release savepoint difficult_bit"
$ ReleaseSavepoint $ Name Nothing "difficult_bit")
{-
17.7 <commit statement>
<commit statement> ::=
COMMIT [ WORK ] [ AND [ NO ] CHAIN ]
-}
,(TestStatement ansi2011
"commit"
$ Commit)
,(TestStatement ansi2011
"commit work"
$ Commit)
{-
17.8 <rollback statement>
<rollback statement> ::=
ROLLBACK [ WORK ] [ AND [ NO ] CHAIN ] [ <savepoint clause> ]
<savepoint clause> ::=
TO SAVEPOINT <savepoint specifier>
-}
,(TestStatement ansi2011
"rollback"
$ Rollback Nothing)
,(TestStatement ansi2011
"rollback work"
$ Rollback Nothing)
,(TestStatement ansi2011
"rollback to savepoint difficult_bit"
$ Rollback $ Just $ Name Nothing "difficult_bit")
{-
19 Session management
19.1 <set session characteristics statement>
<set session characteristics statement> ::=
SET SESSION CHARACTERISTICS AS <session characteristic list>
<session characteristic list> ::=
<session characteristic> [ { <comma> <session characteristic> }... ]
<session characteristic> ::=
<session transaction characteristics>
<session transaction characteristics> ::=
TRANSACTION <transaction mode> [ { <comma> <transaction mode> }... ]
19.2 <set session user identifier statement>
<set session user identifier statement> ::=
SET SESSION AUTHORIZATION <value specification>
19.3 <set role statement>
<set role statement> ::=
SET ROLE <role specification>
<role specification> ::=
<value specification>
| NONE
19.4 <set local time zone statement>
<set local time zone statement> ::=
SET TIME ZONE <set time zone value>
<set time zone value> ::=
<interval value expression>
| LOCAL
19.5 <set catalog statement>
<set catalog statement> ::=
SET <catalog name characteristic>
<catalog name characteristic> ::=
CATALOG <value specification>
19.6 <set schema statement>
<set schema statement> ::=
SET <schema name characteristic>
<schema name characteristic> ::=
SCHEMA <value specification>
19.7 <set names statement>
<set names statement> ::=
SET <character set name characteristic>
<character set name characteristic> ::=
NAMES <value specification>
19.8 <set path statement>
<set path statement> ::=
SET <SQL-path characteristic>
<SQL-path characteristic> ::=
PATH <value specification>
19.9 <set transform group statement>
<set transform group statement> ::=
SET <transform group characteristic>
<transform group characteristic> ::=
DEFAULT TRANSFORM GROUP <value specification>
| TRANSFORM GROUP FOR TYPE <path-resolved user-defined type name> <value specification>
19.10 <set session collation statement>
<set session collation statement> ::=
SET COLLATION <collation specification> [ FOR <character set specification list> ]
| SET NO COLLATION [ FOR <character set specification list> ]
<collation specification> ::=
<value specification>
-}
]

555
tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs Normal file
View file

@ -0,0 +1,555 @@
-- Section 14 in Foundation
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
sql2011DataManipulationTests :: TestItem
sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
[
{-
14 Data manipulation
14.1 <declare cursor>
<declare cursor> ::=
DECLARE <cursor name> <cursor properties>
FOR <cursor specification>
14.2 <cursor properties>
<cursor properties> ::=
[ <cursor sensitivity> ] [ <cursor scrollability> ] CURSOR
[ <cursor holdability> ]
[ <cursor returnability> ]
<cursor sensitivity> ::=
SENSITIVE
| INSENSITIVE
| ASENSITIVE
<cursor scrollability> ::=
SCROLL
| NO SCROLL
<cursor holdability> ::=
WITH HOLD
| WITHOUT HOLD
<cursor returnability> ::=
WITH RETURN
| WITHOUT RETURN
14.3 <cursor specification>
<cursor specification> ::=
<query expression> [ <updatability clause> ]
<updatability clause> ::=
FOR { READ ONLY | UPDATE [ OF <column name list> ] }
14.4 <open statement>
<open statement> ::=
OPEN <cursor name>
14.5 <fetch statement>
<fetch statement> ::=
FETCH [ [ <fetch orientation> ] FROM ] <cursor name> INTO <fetch target list>
<fetch orientation> ::=
NEXT
| PRIOR
| FIRST
| LAST
| { ABSOLUTE | RELATIVE } <simple value specification>
<fetch target list> ::=
<target specification> [ { <comma> <target specification> }... ]
14.6 <close statement>
<close statement> ::=
CLOSE <cursor name>
14.7 <select statement: single row>
<select statement: single row> ::=
SELECT [ <set quantifier> ] <select list>
INTO <select target list>
<table expression>
<select target list> ::=
<target specification> [ { <comma> <target specification> }... ]
14.8 <delete statement: positioned>
<delete statement: positioned> ::=
DELETE FROM <target table> [ [ AS ] <correlation name> ]
WHERE CURRENT OF <cursor name>
<target table> ::=
<table name>
| ONLY <left paren> <table name> <right paren>
14.9 <delete statement: searched>
<delete statement: searched> ::=
DELETE FROM <target table>
[ FOR PORTION OF <application time period name>
FROM <point in time 1> TO <point in time 2> ]
[ [ AS ] <correlation name> ]
[ WHERE <search condition> ]
-}
(TestStatement ansi2011 "delete from t"
$ Delete [Name Nothing "t"] Nothing Nothing)
,(TestStatement ansi2011 "delete from t as u"
$ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing)
,(TestStatement ansi2011 "delete from t where x = 5"
$ Delete [Name Nothing "t"] Nothing
(Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
,(TestStatement ansi2011 "delete from t as u where u.x = 5"
$ Delete [Name Nothing "t"] (Just (Name Nothing "u"))
(Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
{-
14.10 <truncate table statement>
<truncate table statement> ::=
TRUNCATE TABLE <target table> [ <identity column restart option> ]
<identity column restart option> ::=
CONTINUE IDENTITY
| RESTART IDENTITY
-}
,(TestStatement ansi2011 "truncate table t"
$ Truncate [Name Nothing "t"] DefaultIdentityRestart)
,(TestStatement ansi2011 "truncate table t continue identity"
$ Truncate [Name Nothing "t"] ContinueIdentity)
,(TestStatement ansi2011 "truncate table t restart identity"
$ Truncate [Name Nothing "t"] RestartIdentity)
{-
14.11 <insert statement>
<insert statement> ::=
INSERT INTO <insertion target> <insert columns and source>
<insertion target> ::=
<table name>
<insert columns and source> ::=
<from subquery>
| <from constructor>
| <from default>
<from subquery> ::=
[ <left paren> <insert column list> <right paren> ]
[ <override clause> ]
<query expression>
<from constructor> ::=
[ <left paren> <insert column list> <right paren> ]
[ <override clause> ]
<contextually typed table value constructor>
<override clause> ::=
OVERRIDING USER VALUE
| OVERRIDING SYSTEM VALUE
<from default> ::=
DEFAULT VALUES
<insert column list> ::=
<column name list>
-}
,(TestStatement ansi2011 "insert into t select * from u"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "u"]]})
,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"
$ Insert [Name Nothing "t"] (Just [Name Nothing "a", Name Nothing "b", Name Nothing "c"])
$ InsertQuery $ toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "u"]]})
,(TestStatement ansi2011 "insert into t default values"
$ Insert [Name Nothing "t"] Nothing DefaultInsertValues)
,(TestStatement ansi2011 "insert into t values(1,2)"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ Values [[NumLit "1", NumLit "2"]])
,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ Values [[NumLit "1", NumLit "2"]
,[NumLit "3", NumLit "4"]])
,(TestStatement ansi2011
"insert into t values (default,null,array[],multiset[])"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ Values [[Iden [Name Nothing "default"]
,Iden [Name Nothing "null"]
,Array (Iden [Name Nothing "array"]) []
,MultisetCtor []]])
{-
14.12 <merge statement>
<merge statement> ::=
MERGE INTO <target table> [ [ AS ] <merge correlation name> ]
USING <table reference>
ON <search condition> <merge operation specification>
merge into t
using t
on a = b
merge operation specification
merge into t as u
using (table factor | joined expression)
MERGE INTO tablename USING table_reference ON (condition)
WHEN MATCHED THEN
UPDATE SET column1 = value1 [, column2 = value2 ...]
WHEN NOT MATCHED THEN
INSERT (column1 [, column2 ...]) VALUES (value1 [, value2 ...
merge into t23
using t42
on t42.id = t23.id
when matched then
update
set t23.col1 = t42.col1
when not matched then
insert (id, col1)
values (t42.id, t42.col1)
MERGE INTO TableA u
USING (SELECT b.Key1, b.ColB1, c.ColC1
FROM TableB b
INNER JOIN TableC c ON c.KeyC1 = b.KeyB1
) s
ON (u.KeyA1 = s.KeyA1)
WHEN MATCHED THEN
UPDATE SET u.ColA1 = s.ColB1, u.ColA2 = s.ColC1
MERGE INTO Department
USING NewDept AS ND
ON nd.Department_Number = Department.
Department_Number
WHEN MATCHED THEN UPDATE
SET budget_amount = nd.Budget_Amount
WHEN NOT MATCHED THEN INSERT
VALUES
(nd.Department_Number, nd.Department_
Name, nd.Budget_Amount,
nd.Manager_Employee_Number);
MERGE INTO Orders2
USING Orders3
ON ORDERS3.Order_Number = Orders2.
Order_Number
WHEN NOT MATCHED THEN INSERT
Orders3.order_number, Orders3.
invoice_number,
Orders3.customer_number, Orders3.
initial_order_date,
Orders3.invoice_date, Orders3.
invoice_amount);
MERGE INTO Orders2
USING Orders3
ON ORDERS3.Order_Number = Orders2.
Order_Number AND 1=0
WHEN NOT MATCHED THEN INSERT
(Orders3.order_number, Orders3.invoice_number,
Orders3.customer_number, Orders3.
initial_order_date,
Orders3.invoice_date, Orders3.
invoice_amount);
MERGE INTO Department
USING NewDept AS ND
ON nd.Department_Number = Department.
Department_Number
WHEN MATCHED THEN UPDATE
SET budget_amount = nd.Budget_Amount
LOGGING ALL ERRORS WITH NO LIMIT;
MERGE INTO Department
USING
(SELECT Department_Number,
department_name,
Budget_Amount,
Manager_Employee_Number
FROM NewDept
WHERE Department_Number IN
(SELECT Department_Number
FROM Employee)) AS m
ON m.Department_Number = Department.
Department_Number
WHEN MATCHED THEN UPDATE
SET budget_amount = m.Budget_Amount
WHEN NOT MATCHED THEN INSERT
(m.Department_Number, m.Department_
Name, m.Budget_Amount,
m.Manager_Employee_Number)
LOGGING ALL ERRORS WITH NO LIMIT;
MERGE INTO Customers AS c
USING Moved AS m
ON m.SSN = c.SSN
WHEN MATCHED
THEN UPDATE
SET Street = m.Street,
HouseNo = m.HouseNo,
City = m.City;
MERGE INTO CentralOfficeAccounts AS C -- Target
USING BranchOfficeAccounts AS B -- Source
ON C.account_nbr = B.account_nbr
WHEN MATCHED THEN -- On match update
UPDATE SET C.company_name = B.company_name,
C.primary_contact = B.primary_contact,
C.contact_phone = B.contact_phone
WHEN NOT MATCHED THEN -- Add missing
INSERT (account_nbr, company_name, primary_contact, contact_phone)
VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);
SELECT account_nbr, company_name, primary_contact, contact_phone
FROM CentralOfficeAccounts;
MERGE INTO CentralOfficeAccounts AS C -- Target
USING BranchOfficeAccounts AS B -- Source
ON C.account_nbr = B.account_nbr
WHEN MATCHED -- On match update
AND (C.company_name <> B.company_name -- Additional search conditions
OR C.primary_contact <> B.primary_contact
OR C.contact_phone <> B.contact_phone) THEN
UPDATE SET C.company_name = B.company_name,
C.primary_contact = B.primary_contact,
C.contact_phone = B.contact_phone
WHEN NOT MATCHED THEN -- Add missing
INSERT (account_nbr, company_name, primary_contact, contact_phone)
VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone);
MERGE INTO CentralOfficeAccounts AS C -- Target
USING BranchOfficeAccounts AS B -- Source
ON C.account_nbr = B.account_nbr
WHEN MATCHED -- On match update
AND (C.company_name <> B.company_name -- Additional search conditions
OR C.primary_contact <> B.primary_contact
OR C.contact_phone <> B.contact_phone) THEN
UPDATE SET C.company_name = B.company_name,
C.primary_contact = B.primary_contact,
C.contact_phone = B.contact_phone
WHEN NOT MATCHED THEN -- Add missing
INSERT (account_nbr, company_name, primary_contact, contact_phone)
VALUES (B.account_nbr, B.company_name, B.primary_contact, B.contact_phone)
WHEN SOURCE NOT MATCHED THEN -- Delete missing from source
DELETE;
SELECT account_nbr, company_name, primary_contact, contact_phone
FROM CentralOfficeAccounts;
<merge correlation name> ::=
<correlation name>
<merge operation specification> ::=
<merge when clause>...
<merge when clause> ::=
<merge when matched clause>
| <merge when not matched clause>
<merge when matched clause> ::=
WHEN MATCHED [ AND <search condition> ]
THEN <merge update or delete specification>
<merge update or delete specification> ::=
<merge update specification>
| <merge delete specification>
<merge when not matched clause> ::=
WHEN NOT MATCHED [ AND <search condition> ]
THEN <merge insert specification>
<merge update specification> ::=
UPDATE SET <set clause list>
<merge delete specification> ::=
DELETE
<merge insert specification> ::=
INSERT [ <left paren> <insert column list> <right paren> ]
[ <override clause> ]
VALUES <merge insert value list>
<merge insert value list> ::=
<left paren>
<merge insert value element> [ { <comma> <merge insert value element> }... ]
<right paren>
<merge insert value element> ::=
<value expression>
| <contextually typed value specification>
14.13 <update statement: positioned>
<updatestatement: positioned> ::=
UPDATE <target table> [ [ AS ] <correlation name> ]
SET <set clause list>
WHERE CURRENT OF <cursor name>
14.14 <update statement: searched>
<update statement: searched> ::=
UPDATE <target table>
[ FOR PORTION OF <application time period name>
FROM <point in time 1> TO <point in time 2> ]
[ [ AS ] <correlation name> ]
SET <set clause list>
[ WHERE <search condition> ]
-}
,(TestStatement ansi2011 "update t set a=b"
$ Update [Name Nothing "t"] Nothing
[Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)
,(TestStatement ansi2011 "update t set a=b, c=5"
$ Update [Name Nothing "t"] Nothing
[Set [Name Nothing "a"] (Iden [Name Nothing "b"])
,Set [Name Nothing "c"] (NumLit "5")] Nothing)
,(TestStatement ansi2011 "update t set a=b where a>5"
$ Update [Name Nothing "t"] Nothing
[Set [Name Nothing "a"] (Iden [Name Nothing "b"])]
$ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))
,(TestStatement ansi2011 "update t as u set a=b where u.a>5"
$ Update [Name Nothing "t"] (Just $ Name Nothing "u")
[Set [Name Nothing "a"] (Iden [Name Nothing "b"])]
$ Just $ BinOp (Iden [Name Nothing "u",Name Nothing "a"])
[Name Nothing ">"] (NumLit "5"))
,(TestStatement ansi2011 "update t set (a,b)=(3,5)"
$ Update [Name Nothing "t"] Nothing
[SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]
[NumLit "3", NumLit "5"]] Nothing)
{-
14.15 <set clause list>
<set clause list> ::=
<set clause> [ { <comma> <set clause> }... ]
<set clause> ::=
<multiple column assignment>
| <set target> <equals operator> <update source>
<set target> ::=
<update target>
| <mutated set clause>
<multiple column assignment> ::=
<set target list> <equals operator> <assigned row>
<set target list> ::=
<left paren> <set target> [ { <comma> <set target> }... ] <right paren>
<assigned row> ::=
<contextually typed row value expression>
<update target> ::=
<object column>
| <object column>
<left bracket or trigraph> <simple value specification> <right bracket or trigraph>
<object column> ::=
<column name>
<mutated set clause> ::=
<mutated target> <period> <method name>
<mutated target> ::=
<object column>
| <mutated set clause>
<update source> ::=
<value expression>
| <contextually typed value specification>
14.16 <temporary table declaration>
<temporary table declaration> ::=
DECLARE LOCAL TEMPORARY TABLE <table name> <table element list>
[ ON COMMIT <table commit action> ROWS ]
declare local temporary table t (a int) [on commit {preserve | delete} rows]
14.17 <free locator statement>
<free locator statement> ::=
FREE LOCATOR <locator reference> [ { <comma> <locator reference> }... ]
<locator reference> ::=
<host parameter name>
| <embedded variable name>
| <dynamic parameter specification>
14.18 <hold locator statement>
<hold locator statement> ::=
HOLD LOCATOR <locator reference> [ { <comma> <locator reference> }... ]
-}
]

4520
tests/Language/SQL/SimpleSQL/SQL2011Queries.hs Normal file
View file

File diff suppressed because it is too large Load diff

2158
tests/Language/SQL/SimpleSQL/SQL2011Schema.hs Normal file
View file

File diff suppressed because it is too large Load diff

433
tests/Language/SQL/SimpleSQL/ScalarExprs.hs Normal file
View file

@ -0,0 +1,433 @@
-- Tests for parsing scalar expressions
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
scalarExprTests :: TestItem
scalarExprTests = Group "scalarExprTests"
[literals
,identifiers
,star
,parameter
,dots
,app
,caseexp
,convertfun
,operators
,parens
,subqueries
,aggregates
,windowFunctions
,functionsWithReservedNames
]
literals :: TestItem
literals = Group "literals" $ map (uncurry (TestScalarExpr ansi2011))
[("3", NumLit "3")
,("3.", NumLit "3.")
,("3.3", NumLit "3.3")
,(".3", NumLit ".3")
,("3.e3", NumLit "3.e3")
,("3.3e3", NumLit "3.3e3")
,(".3e3", NumLit ".3e3")
,("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")
,("interval '3' day"
,IntervalLit Nothing "3" (Itf "day" Nothing) Nothing)
,("interval '3' day (3)"
,IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing)
,("interval '3 weeks'", TypedLit (TypeName [Name Nothing "interval"]) "3 weeks")
]
identifiers :: TestItem
identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))
[("iden1", Iden [Name Nothing "iden1"])
--,("t.a", Iden2 "t" "a")
,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])
,("\"from\"", Iden [Name (Just ("\"","\"")) "from"])
]
star :: TestItem
star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))
[("*", Star)
--,("t.*", Star2 "t")
--,("ROW(t.*,42)", App "ROW" [Star2 "t", NumLit "42"])
]
parameter :: TestItem
parameter = Group "parameter"
[TestScalarExpr ansi2011 "?" Parameter
,TestScalarExpr postgres "$13" $ PositionalArg 13]
dots :: TestItem
dots = Group "dot" $ map (uncurry (TestScalarExpr ansi2011))
[("t.a", Iden [Name Nothing "t",Name Nothing "a"])
,("t.*", BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star)
,("a.b.c", Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"])
,("ROW(t.*,42)", App [Name Nothing "ROW"] [BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star, NumLit "42"])
]
app :: TestItem
app = Group "app" $ map (uncurry (TestScalarExpr ansi2011))
[("f()", App [Name Nothing "f"] [])
,("f(a)", App [Name Nothing "f"] [Iden [Name Nothing "a"]])
,("f(a,b)", App [Name Nothing "f"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])
]
caseexp :: TestItem
caseexp = Group "caseexp" $ map (uncurry (TestScalarExpr ansi2011))
[("case a when 1 then 2 end"
,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"]
,NumLit "2")] Nothing)
,("case a when 1 then 2 when 3 then 4 end"
,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")
,([NumLit "3"], NumLit "4")] Nothing)
,("case a when 1 then 2 when 3 then 4 else 5 end"
,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1"], NumLit "2")
,([NumLit "3"], NumLit "4")]
(Just $ NumLit "5"))
,("case when a=1 then 2 when a=3 then 4 else 5 end"
,Case Nothing [([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "1")], NumLit "2")
,([BinOp (Iden [Name Nothing "a"]) [Name Nothing "="] (NumLit "3")], NumLit "4")]
(Just $ NumLit "5"))
,("case a when 1,2 then 10 when 3,4 then 20 end"
,Case (Just $ Iden [Name Nothing "a"]) [([NumLit "1",NumLit "2"]
,NumLit "10")
,([NumLit "3",NumLit "4"]
,NumLit "20")]
Nothing)
]
convertfun :: TestItem
convertfun = Group "convert" $ map (uncurry (TestScalarExpr sqlserver))
[("CONVERT(varchar, 25.65)"
,Convert (TypeName [Name Nothing "varchar"]) (NumLit "25.65") Nothing)
,("CONVERT(datetime, '2017-08-25')"
,Convert (TypeName [Name Nothing "datetime"]) (StringLit "'" "'" "2017-08-25") Nothing)
,("CONVERT(varchar, '2017-08-25', 101)"
,Convert (TypeName [Name Nothing "varchar"]) (StringLit "'" "'" "2017-08-25") (Just 101))
]
operators :: TestItem
operators = Group "operators"
[binaryOperators
,unaryOperators
,casts
,miscOps]
binaryOperators :: TestItem
binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
[("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))
-- sanity check fixities
-- todo: add more fixity checking
,("a + b * c"
,BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]
(BinOp (Iden [Name Nothing "b"]) [Name Nothing "*"] (Iden [Name Nothing "c"])))
,("a * b + c"
,BinOp (BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (Iden [Name Nothing "b"]))
[Name Nothing "+"] (Iden [Name Nothing "c"]))
]
unaryOperators :: TestItem
unaryOperators = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
[("not a", PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])
,("not not a", PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"])
,("+a", PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"])
,("-a", PrefixOp [Name Nothing "-"] $ Iden [Name Nothing "a"])
]
casts :: TestItem
casts = Group "operators" $ map (uncurry (TestScalarExpr ansi2011))
[("cast('1' as int)"
,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"])
,("int '3'"
,TypedLit (TypeName [Name Nothing "int"]) "3")
,("cast('1' as double precision)"
,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])
,("cast('1' as float(8))"
,Cast (StringLit "'" "'" "1") $ PrecTypeName [Name Nothing "float"] 8)
,("cast('1' as decimal(15,2))"
,Cast (StringLit "'" "'" "1") $ PrecScaleTypeName [Name Nothing "decimal"] 15 2)
,("double precision '3'"
,TypedLit (TypeName [Name Nothing "double precision"]) "3")
]
subqueries :: TestItem
subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
[("exists (select a from t)", SubQueryExpr SqExists ms)
,("(select a from t)", SubQueryExpr SqSq ms)
,("a in (select a from t)"
,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))
,("a not in (select a from t)"
,In False (Iden [Name Nothing "a"]) (InQueryExpr ms))
,("a > all (select a from t)"
,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing ">"] CPAll ms)
,("a = some (select a from t)"
,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPSome ms)
,("a <= any (select a from t)"
,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms)
]
where
ms = toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}
miscOps :: TestItem
miscOps = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
[("a in (1,2,3)"
,In True (Iden [Name Nothing "a"]) $ InList $ map NumLit ["1","2","3"])
,("a is null", PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"]))
,("a is not null", PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"]))
,("a is true", PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"]))
,("a is not true", PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"]))
,("a is false", PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"]))
,("a is not false", PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"]))
,("a is unknown", PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"]))
,("a is not unknown", PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"]))
,("a is distinct from b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is distinct from"] (Iden [Name Nothing "b"]))
,("a is not distinct from b"
,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not distinct from"] (Iden [Name Nothing "b"]))
,("a like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"]))
,("a not like b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"]))
,("a is similar to b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "is similar to"] (Iden [Name Nothing "b"]))
,("a is not similar to b"
,BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"]))
,("a overlaps b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "overlaps"] (Iden [Name Nothing "b"]))
-- special operators
,("a between b and c", SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]
,Iden [Name Nothing "b"]
,Iden [Name Nothing "c"]])
,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]
,Iden [Name Nothing "b"]
,Iden [Name Nothing "c"]])
,("(1,2)"
,SpecialOp [Name Nothing "rowctor"] [NumLit "1", NumLit "2"])
-- keyword special operators
,("extract(day from t)"
, SpecialOpK [Name Nothing "extract"] (Just $ Iden [Name Nothing "day"]) [("from", Iden [Name Nothing "t"])])
,("substring(x from 1 for 2)"
,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")
,("for", NumLit "2")])
,("substring(x from 1)"
,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("from", NumLit "1")])
,("substring(x for 2)"
,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"]) [("for", NumLit "2")])
,("substring(x from 1 for 2 collate C)"
,SpecialOpK [Name Nothing "substring"] (Just $ Iden [Name Nothing "x"])
[("from", NumLit "1")
,("for", Collate (NumLit "2") [Name Nothing "C"])])
-- this doesn't work because of a overlap in the 'in' parser
,("POSITION( string1 IN string2 )"
,SpecialOpK [Name Nothing "position"] (Just $ Iden [Name Nothing "string1"]) [("in", Iden [Name Nothing "string2"])])
,("CONVERT(char_value USING conversion_char_name)"
,SpecialOpK [Name Nothing "convert"] (Just $ Iden [Name Nothing "char_value"])
[("using", Iden [Name Nothing "conversion_char_name"])])
,("TRANSLATE(char_value USING translation_name)"
,SpecialOpK [Name Nothing "translate"] (Just $ Iden [Name Nothing "char_value"])
[("using", Iden [Name Nothing "translation_name"])])
{-
OVERLAY(string PLACING embedded_string FROM start
[FOR length])
-}
,("OVERLAY(string PLACING embedded_string FROM start)"
,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
[("placing", Iden [Name Nothing "embedded_string"])
,("from", Iden [Name Nothing "start"])])
,("OVERLAY(string PLACING embedded_string FROM start FOR length)"
,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
[("placing", Iden [Name Nothing "embedded_string"])
,("from", Iden [Name Nothing "start"])
,("for", Iden [Name Nothing "length"])])
{-
TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
target_string
[COLLATE collation_name] )
-}
,("trim(from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("both", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("trim(leading from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("leading", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("trim(trailing from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("trailing", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("trim(both from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("both", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("trim(leading 'x' from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("leading", StringLit "'" "'" "x")
,("from", Iden [Name Nothing "target_string"])])
,("trim(trailing 'y' from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("trailing", StringLit "'" "'" "y")
,("from", Iden [Name Nothing "target_string"])])
,("trim(both 'z' from target_string collate C)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("both", StringLit "'" "'" "z")
,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])])
,("trim(leading from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
[("leading", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
]
aggregates :: TestItem
aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))
[("count(*)",App [Name Nothing "count"] [Star])
,("sum(a order by a)"
,AggregateApp [Name Nothing "sum"] SQDefault [Iden [Name Nothing "a"]]
[SortSpec (Iden [Name Nothing "a"]) DirDefault NullsOrderDefault] Nothing)
,("sum(all a)"
,AggregateApp [Name Nothing "sum"] All [Iden [Name Nothing "a"]] [] Nothing)
,("count(distinct a)"
,AggregateApp [Name Nothing "count"] Distinct [Iden [Name Nothing "a"]] [] Nothing)
]
windowFunctions :: TestItem
windowFunctions = Group "windowFunctions" $ map (uncurry (TestScalarExpr ansi2011))
[("max(a) over ()", WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing)
,("count(*) over ()", WindowApp [Name Nothing "count"] [Star] [] [] Nothing)
,("max(a) over (partition by b)"
,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]] [] Nothing)
,("max(a) over (partition by b,c)"
,WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"],Iden [Name Nothing "c"]] [] Nothing)
,("sum(a) over (order by b)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []
[SortSpec (Iden [Name Nothing "b"]) DirDefault NullsOrderDefault] Nothing)
,("sum(a) over (order by b desc,c)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] []
[SortSpec (Iden [Name Nothing "b"]) Desc NullsOrderDefault
,SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)
,("sum(a) over (partition by b order by c)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault] Nothing)
,("sum(a) over (partition by b order by c range unbounded preceding)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
$ Just $ FrameFrom FrameRange UnboundedPreceding)
,("sum(a) over (partition by b order by c range 5 preceding)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
$ Just $ FrameFrom FrameRange $ Preceding (NumLit "5"))
,("sum(a) over (partition by b order by c range current row)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
$ Just $ FrameFrom FrameRange Current)
,("sum(a) over (partition by b order by c rows 5 following)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
$ Just $ FrameFrom FrameRows $ Following (NumLit "5"))
,("sum(a) over (partition by b order by c range unbounded following)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
$ Just $ FrameFrom FrameRange UnboundedFollowing)
,("sum(a) over (partition by b order by c \n\
\range between 5 preceding and 5 following)"
,WindowApp [Name Nothing "sum"] [Iden [Name Nothing "a"]] [Iden [Name Nothing "b"]]
[SortSpec (Iden [Name Nothing "c"]) DirDefault NullsOrderDefault]
$ Just $ FrameBetween FrameRange
(Preceding (NumLit "5"))
(Following (NumLit "5")))
]
parens :: TestItem
parens = Group "parens" $ map (uncurry (TestScalarExpr ansi2011))
[("(a)", Parens (Iden [Name Nothing "a"]))
,("(a + b)", Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"])))
]
functionsWithReservedNames :: TestItem
functionsWithReservedNames = Group "functionsWithReservedNames" $ map t
["abs"
,"char_length"
]
where
t fn = TestScalarExpr ansi2011 (fn <> "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]

108
tests/Language/SQL/SimpleSQL/TableRefs.hs Normal file
View file

@ -0,0 +1,108 @@
{-
These are the tests for parsing focusing on the from part of query
expression
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
tableRefTests :: TestItem
tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))
[("select a from t"
,ms [TRSimple [Name Nothing "t"]])
,("select a from f(a)"
,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])
,("select a from t,u"
,ms [TRSimple [Name Nothing "t"], TRSimple [Name Nothing "u"]])
,("select a from s.t"
,ms [TRSimple [Name Nothing "s", Name Nothing "t"]])
-- these lateral queries make no sense but the syntax is valid
,("select a from lateral a"
,ms [TRLateral $ TRSimple [Name Nothing "a"]])
,("select a from lateral a,b"
,ms [TRLateral $ TRSimple [Name Nothing "a"], TRSimple [Name Nothing "b"]])
,("select a from a, lateral b"
,ms [TRSimple [Name Nothing "a"], TRLateral $ TRSimple [Name Nothing "b"]])
,("select a from a natural join lateral b"
,ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner
(TRLateral $ TRSimple [Name Nothing "b"])
Nothing])
,("select a from lateral a natural join lateral b"
,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner
(TRLateral $ TRSimple [Name Nothing "b"])
Nothing])
,("select a from t inner join u on expr"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
(Just $ JoinOn $ Iden [Name Nothing "expr"])])
,("select a from t join u on expr"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
(Just $ JoinOn $ Iden [Name Nothing "expr"])])
,("select a from t left join u on expr"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False JLeft (TRSimple [Name Nothing "u"])
(Just $ JoinOn $ Iden [Name Nothing "expr"])])
,("select a from t right join u on expr"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False JRight (TRSimple [Name Nothing "u"])
(Just $ JoinOn $ Iden [Name Nothing "expr"])])
,("select a from t full join u on expr"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False JFull (TRSimple [Name Nothing "u"])
(Just $ JoinOn $ Iden [Name Nothing "expr"])])
,("select a from t cross join u"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False
JCross (TRSimple [Name Nothing "u"]) Nothing])
,("select a from t natural inner join u"
,ms [TRJoin (TRSimple [Name Nothing "t"]) True JInner (TRSimple [Name Nothing "u"])
Nothing])
,("select a from t inner join u using(a,b)"
,ms [TRJoin (TRSimple [Name Nothing "t"]) False JInner (TRSimple [Name Nothing "u"])
(Just $ JoinUsing [Name Nothing "a", Name Nothing "b"])])
,("select a from (select a from t)"
,ms [TRQueryExpr $ ms [TRSimple [Name Nothing "t"]]])
,("select a from t as u"
,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])
,("select a from t u"
,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") Nothing)])
,("select a from t u(b)"
,ms [TRAlias (TRSimple [Name Nothing "t"]) (Alias (Name Nothing "u") $ Just [Name Nothing "b"])])
,("select a from (t cross join u) as u"
,ms [TRAlias (TRParens $
TRJoin (TRSimple [Name Nothing "t"]) False JCross (TRSimple [Name Nothing "u"]) Nothing)
(Alias (Name Nothing "u") Nothing)])
-- todo: not sure if the associativity is correct
,("select a from t cross join u cross join v",
ms [TRJoin
(TRJoin (TRSimple [Name Nothing "t"]) False
JCross (TRSimple [Name Nothing "u"]) Nothing)
False JCross (TRSimple [Name Nothing "v"]) Nothing])
]
where
ms f = toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = f}

45
tests/Language/SQL/SimpleSQL/TestTypes.hs Normal file
View file

@ -0,0 +1,45 @@
{-
This is the types used to define the tests as pure data. See the
Tests.hs module for the 'interpreter'.
-}
module Language.SQL.SimpleSQL.TestTypes
(TestItem(..)
,module Language.SQL.SimpleSQL.Dialect
) where
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.Lex (Token)
import Language.SQL.SimpleSQL.Dialect
import Data.Text (Text)
{-
TODO: maybe make the dialect args into [dialect], then each test
checks all the dialects mentioned work, and all the dialects not
mentioned give a parse error. Not sure if this will be too awkward due
to lots of tricky exceptions/variationsx.
-}
data TestItem = Group Text [TestItem]
| TestScalarExpr Dialect Text ScalarExpr
| TestQueryExpr Dialect Text QueryExpr
| TestStatement Dialect Text Statement
| TestStatements Dialect Text [Statement]
{-
this just checks the sql parses without error, mostly just a
intermediate when I'm too lazy to write out the parsed AST. These
should all be TODO to convert to a testqueryexpr test.
-}
| ParseQueryExpr Dialect Text
-- check that the string given fails to parse
| ParseQueryExprFails Dialect Text
| ParseScalarExprFails Dialect Text
| LexTest Dialect Text [Token]
| LexFails Dialect Text
deriving (Eq,Show)

180
tests/Language/SQL/SimpleSQL/Tests.hs Normal file
View file

@ -0,0 +1,180 @@
{-
This is the main tests module which exposes the test data plus the
Test.Framework tests. It also contains the code which converts the
test data to the Test.Framework tests.
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.Tests
(testData
,tests
,TestItem(..)
) where
import qualified Test.Tasty as T
import qualified Test.Tasty.HUnit as H
--import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.Pretty
import Language.SQL.SimpleSQL.Parse
import qualified Language.SQL.SimpleSQL.Lex as Lex
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.FullQueries
import Language.SQL.SimpleSQL.GroupBy
import Language.SQL.SimpleSQL.Postgres
import Language.SQL.SimpleSQL.QueryExprComponents
import Language.SQL.SimpleSQL.QueryExprs
import Language.SQL.SimpleSQL.TableRefs
import Language.SQL.SimpleSQL.ScalarExprs
import Language.SQL.SimpleSQL.Odbc
import Language.SQL.SimpleSQL.Tpch
import Language.SQL.SimpleSQL.LexerTests
import Language.SQL.SimpleSQL.EmptyStatement
import Language.SQL.SimpleSQL.CreateIndex
import Language.SQL.SimpleSQL.SQL2011Queries
import Language.SQL.SimpleSQL.SQL2011AccessControl
import Language.SQL.SimpleSQL.SQL2011Bits
import Language.SQL.SimpleSQL.SQL2011DataManipulation
import Language.SQL.SimpleSQL.SQL2011Schema
import Language.SQL.SimpleSQL.MySQL
import Language.SQL.SimpleSQL.Oracle
import Language.SQL.SimpleSQL.CustomDialect
import Data.Text (Text)
import qualified Data.Text as T
{-
Order the tests to start from the simplest first. This is also the
order on the generated documentation.
-}
testData :: TestItem
testData =
Group "parserTest"
[lexerTests
,scalarExprTests
,odbcTests
,queryExprComponentTests
,queryExprsTests
,tableRefTests
,groupByTests
,fullQueriesTests
,postgresTests
,tpchTests
,sql2011QueryTests
,sql2011DataManipulationTests
,sql2011SchemaTests
,sql2011AccessControlTests
,sql2011BitsTests
,mySQLTests
,oracleTests
,customDialectTests
,emptyStatementTests
,createIndexTests
]
tests :: T.TestTree
tests = itemToTest testData
--runTests :: IO ()
--runTests = void $ H.runTestTT $ itemToTest testData
itemToTest :: TestItem -> T.TestTree
itemToTest (Group nm ts) =
T.testGroup (T.unpack nm) $ map itemToTest ts
itemToTest (TestScalarExpr d str expected) =
toTest parseScalarExpr prettyScalarExpr d str expected
itemToTest (TestQueryExpr d str expected) =
toTest parseQueryExpr prettyQueryExpr d str expected
itemToTest (TestStatement d str expected) =
toTest parseStatement prettyStatement d str expected
itemToTest (TestStatements d str expected) =
toTest parseStatements prettyStatements d str expected
itemToTest (ParseQueryExpr d str) =
toPTest parseQueryExpr prettyQueryExpr d str
itemToTest (ParseQueryExprFails d str) =
toFTest parseQueryExpr prettyQueryExpr d str
itemToTest (ParseScalarExprFails d str) =
toFTest parseScalarExpr prettyScalarExpr d str
itemToTest (LexTest d s ts) = makeLexerTest d s ts
itemToTest (LexFails d s) = makeLexingFailsTest d s
makeLexerTest :: Dialect -> Text -> [Lex.Token] -> T.TestTree
makeLexerTest d s ts = H.testCase (T.unpack s) $ do
let ts1 = either (error . T.unpack . Lex.prettyError) id $ Lex.lexSQL d "" Nothing s
H.assertEqual "" ts ts1
let s' = Lex.prettyTokens d $ ts1
H.assertEqual "pretty print" s s'
makeLexingFailsTest :: Dialect -> Text -> T.TestTree
makeLexingFailsTest d s = H.testCase (T.unpack s) $ do
case Lex.lexSQL d "" Nothing s of
Right x -> H.assertFailure $ "lexing should have failed: " ++ T.unpack s ++ "\ngot: " ++ show x
Left _ -> pure ()
toTest :: (Eq a, Show a) =>
(Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a)
-> (Dialect -> a -> Text)
-> Dialect
-> Text
-> a
-> T.TestTree
toTest parser pp d str expected = H.testCase (T.unpack str) $ do
let egot = parser d "" Nothing str
case egot of
Left e -> H.assertFailure $ T.unpack $ prettyError e
Right got -> H.assertEqual "" expected got
let str' = pp d expected
egot' = parser d "" Nothing str'
case egot' of
Left e' ->
H.assertFailure $ "pp roundtrip"
++ "\n" ++ (T.unpack str')
++ (T.unpack $ prettyError e')
Right got' ->
H.assertEqual
("pp roundtrip" ++ "\n" ++ T.unpack str')
expected got'
toPTest :: (Eq a, Show a) =>
(Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a)
-> (Dialect -> a -> Text)
-> Dialect
-> Text
-> T.TestTree
toPTest parser pp d str = H.testCase (T.unpack str) $ do
let egot = parser d "" Nothing str
case egot of
Left e -> H.assertFailure $ T.unpack $ prettyError e
Right got -> do
let str' = pp d got
let egot' = parser d "" Nothing str'
case egot' of
Left e' -> H.assertFailure $ "pp roundtrip "
++ "\n" ++ T.unpack str' ++ "\n"
++ T.unpack (prettyError e')
Right _got' -> return ()
toFTest :: (Eq a, Show a) =>
(Dialect -> Text -> Maybe (Int,Int) -> Text -> Either ParseError a)
-> (Dialect -> a -> Text)
-> Dialect
-> Text
-> T.TestTree
toFTest parser _pp d str = H.testCase (T.unpack str) $ do
let egot = parser d "" Nothing str
case egot of
Left _e -> return ()
Right _got ->
H.assertFailure $ "parse didn't fail: " ++ show d ++ "\n" ++ T.unpack str

688
tests/Language/SQL/SimpleSQL/Tpch.hs Normal file
View file

@ -0,0 +1,688 @@
{-
Some tests for parsing the tpch queries
The changes made to the official syntax are:
1. replace the set rowcount with ansi standard fetch first n rows only
2. replace the create view, query, drop view sequence with a query
using a common table expression
-}
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.Tpch (tpchTests,tpchQueries) where
import Language.SQL.SimpleSQL.TestTypes
import Data.Text (Text)
tpchTests :: TestItem
tpchTests =
Group "parse tpch"
$ map (ParseQueryExpr ansi2011 . snd) tpchQueries
tpchQueries :: [(String,Text)]
tpchQueries =
[("Q1","\n\
\select\n\
\ l_returnflag,\n\
\ l_linestatus,\n\
\ sum(l_quantity) as sum_qty,\n\
\ sum(l_extendedprice) as sum_base_price,\n\
\ sum(l_extendedprice * (1 - l_discount)) as sum_disc_price,\n\
\ sum(l_extendedprice * (1 - l_discount) * (1 + l_tax)) as sum_charge,\n\
\ avg(l_quantity) as avg_qty,\n\
\ avg(l_extendedprice) as avg_price,\n\
\ avg(l_discount) as avg_disc,\n\
\ count(*) as count_order\n\
\from\n\
\ lineitem\n\
\where\n\
\ l_shipdate <= date '1998-12-01' - interval '63' day (3)\n\
\group by\n\
\ l_returnflag,\n\
\ l_linestatus\n\
\order by\n\
\ l_returnflag,\n\
\ l_linestatus")
,("Q2","\n\
\select\n\
\ s_acctbal,\n\
\ s_name,\n\
\ n_name,\n\
\ p_partkey,\n\
\ p_mfgr,\n\
\ s_address,\n\
\ s_phone,\n\
\ s_comment\n\
\from\n\
\ part,\n\
\ supplier,\n\
\ partsupp,\n\
\ nation,\n\
\ region\n\
\where\n\
\ p_partkey = ps_partkey\n\
\ and s_suppkey = ps_suppkey\n\
\ and p_size = 15\n\
\ and p_type like '%BRASS'\n\
\ and s_nationkey = n_nationkey\n\
\ and n_regionkey = r_regionkey\n\
\ and r_name = 'EUROPE'\n\
\ and ps_supplycost = (\n\
\ select\n\
\ min(ps_supplycost)\n\
\ from\n\
\ partsupp,\n\
\ supplier,\n\
\ nation,\n\
\ region\n\
\ where\n\
\ p_partkey = ps_partkey\n\
\ and s_suppkey = ps_suppkey\n\
\ and s_nationkey = n_nationkey\n\
\ and n_regionkey = r_regionkey\n\
\ and r_name = 'EUROPE'\n\
\ )\n\
\order by\n\
\ s_acctbal desc,\n\
\ n_name,\n\
\ s_name,\n\
\ p_partkey\n\
\fetch first 100 rows only")
,("Q3","\n\
\ select\n\
\ l_orderkey,\n\
\ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
\ o_orderdate,\n\
\ o_shippriority\n\
\ from\n\
\ customer,\n\
\ orders,\n\
\ lineitem\n\
\ where\n\
\ c_mktsegment = 'MACHINERY'\n\
\ and c_custkey = o_custkey\n\
\ and l_orderkey = o_orderkey\n\
\ and o_orderdate < date '1995-03-21'\n\
\ and l_shipdate > date '1995-03-21'\n\
\ group by\n\
\ l_orderkey,\n\
\ o_orderdate,\n\
\ o_shippriority\n\
\ order by\n\
\ revenue desc,\n\
\ o_orderdate\n\
\ fetch first 10 rows only")
,("Q4","\n\
\ select\n\
\ o_orderpriority,\n\
\ count(*) as order_count\n\
\ from\n\
\ orders\n\
\ where\n\
\ o_orderdate >= date '1996-03-01'\n\
\ and o_orderdate < date '1996-03-01' + interval '3' month\n\
\ and exists (\n\
\ select\n\
\ *\n\
\ from\n\
\ lineitem\n\
\ where\n\
\ l_orderkey = o_orderkey\n\
\ and l_commitdate < l_receiptdate\n\
\ )\n\
\ group by\n\
\ o_orderpriority\n\
\ order by\n\
\ o_orderpriority")
,("Q5","\n\
\ select\n\
\ n_name,\n\
\ sum(l_extendedprice * (1 - l_discount)) as revenue\n\
\ from\n\
\ customer,\n\
\ orders,\n\
\ lineitem,\n\
\ supplier,\n\
\ nation,\n\
\ region\n\
\ where\n\
\ c_custkey = o_custkey\n\
\ and l_orderkey = o_orderkey\n\
\ and l_suppkey = s_suppkey\n\
\ and c_nationkey = s_nationkey\n\
\ and s_nationkey = n_nationkey\n\
\ and n_regionkey = r_regionkey\n\
\ and r_name = 'EUROPE'\n\
\ and o_orderdate >= date '1997-01-01'\n\
\ and o_orderdate < date '1997-01-01' + interval '1' year\n\
\ group by\n\
\ n_name\n\
\ order by\n\
\ revenue desc")
,("Q6","\n\
\ select\n\
\ sum(l_extendedprice * l_discount) as revenue\n\
\ from\n\
\ lineitem\n\
\ where\n\
\ l_shipdate >= date '1997-01-01'\n\
\ and l_shipdate < date '1997-01-01' + interval '1' year\n\
\ and l_discount between 0.07 - 0.01 and 0.07 + 0.01\n\
\ and l_quantity < 24")
,("Q7","\n\
\ select\n\
\ supp_nation,\n\
\ cust_nation,\n\
\ l_year,\n\
\ sum(volume) as revenue\n\
\ from\n\
\ (\n\
\ select\n\
\ n1.n_name as supp_nation,\n\
\ n2.n_name as cust_nation,\n\
\ extract(year from l_shipdate) as l_year,\n\
\ l_extendedprice * (1 - l_discount) as volume\n\
\ from\n\
\ supplier,\n\
\ lineitem,\n\
\ orders,\n\
\ customer,\n\
\ nation n1,\n\
\ nation n2\n\
\ where\n\
\ s_suppkey = l_suppkey\n\
\ and o_orderkey = l_orderkey\n\
\ and c_custkey = o_custkey\n\
\ and s_nationkey = n1.n_nationkey\n\
\ and c_nationkey = n2.n_nationkey\n\
\ and (\n\
\ (n1.n_name = 'PERU' and n2.n_name = 'IRAQ')\n\
\ or (n1.n_name = 'IRAQ' and n2.n_name = 'PERU')\n\
\ )\n\
\ and l_shipdate between date '1995-01-01' and date '1996-12-31'\n\
\ ) as shipping\n\
\ group by\n\
\ supp_nation,\n\
\ cust_nation,\n\
\ l_year\n\
\ order by\n\
\ supp_nation,\n\
\ cust_nation,\n\
\ l_year")
,("Q8","\n\
\ select\n\
\ o_year,\n\
\ sum(case\n\
\ when nation = 'IRAQ' then volume\n\
\ else 0\n\
\ end) / sum(volume) as mkt_share\n\
\ from\n\
\ (\n\
\ select\n\
\ extract(year from o_orderdate) as o_year,\n\
\ l_extendedprice * (1 - l_discount) as volume,\n\
\ n2.n_name as nation\n\
\ from\n\
\ part,\n\
\ supplier,\n\
\ lineitem,\n\
\ orders,\n\
\ customer,\n\
\ nation n1,\n\
\ nation n2,\n\
\ region\n\
\ where\n\
\ p_partkey = l_partkey\n\
\ and s_suppkey = l_suppkey\n\
\ and l_orderkey = o_orderkey\n\
\ and o_custkey = c_custkey\n\
\ and c_nationkey = n1.n_nationkey\n\
\ and n1.n_regionkey = r_regionkey\n\
\ and r_name = 'MIDDLE EAST'\n\
\ and s_nationkey = n2.n_nationkey\n\
\ and o_orderdate between date '1995-01-01' and date '1996-12-31'\n\
\ and p_type = 'STANDARD ANODIZED BRASS'\n\
\ ) as all_nations\n\
\ group by\n\
\ o_year\n\
\ order by\n\
\ o_year")
,("Q9","\n\
\ select\n\
\ nation,\n\
\ o_year,\n\
\ sum(amount) as sum_profit\n\
\ from\n\
\ (\n\
\ select\n\
\ n_name as nation,\n\
\ extract(year from o_orderdate) as o_year,\n\
\ l_extendedprice * (1 - l_discount) - ps_supplycost * l_quantity as amount\n\
\ from\n\
\ part,\n\
\ supplier,\n\
\ lineitem,\n\
\ partsupp,\n\
\ orders,\n\
\ nation\n\
\ where\n\
\ s_suppkey = l_suppkey\n\
\ and ps_suppkey = l_suppkey\n\
\ and ps_partkey = l_partkey\n\
\ and p_partkey = l_partkey\n\
\ and o_orderkey = l_orderkey\n\
\ and s_nationkey = n_nationkey\n\
\ and p_name like '%antique%'\n\
\ ) as profit\n\
\ group by\n\
\ nation,\n\
\ o_year\n\
\ order by\n\
\ nation,\n\
\ o_year desc")
,("Q10","\n\
\ select\n\
\ c_custkey,\n\
\ c_name,\n\
\ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
\ c_acctbal,\n\
\ n_name,\n\
\ c_address,\n\
\ c_phone,\n\
\ c_comment\n\
\ from\n\
\ customer,\n\
\ orders,\n\
\ lineitem,\n\
\ nation\n\
\ where\n\
\ c_custkey = o_custkey\n\
\ and l_orderkey = o_orderkey\n\
\ and o_orderdate >= date '1993-12-01'\n\
\ and o_orderdate < date '1993-12-01' + interval '3' month\n\
\ and l_returnflag = 'R'\n\
\ and c_nationkey = n_nationkey\n\
\ group by\n\
\ c_custkey,\n\
\ c_name,\n\
\ c_acctbal,\n\
\ c_phone,\n\
\ n_name,\n\
\ c_address,\n\
\ c_comment\n\
\ order by\n\
\ revenue desc\n\
\ fetch first 20 rows only")
,("Q11","\n\
\ select\n\
\ ps_partkey,\n\
\ sum(ps_supplycost * ps_availqty) as value\n\
\ from\n\
\ partsupp,\n\
\ supplier,\n\
\ nation\n\
\ where\n\
\ ps_suppkey = s_suppkey\n\
\ and s_nationkey = n_nationkey\n\
\ and n_name = 'CHINA'\n\
\ group by\n\
\ ps_partkey having\n\
\ sum(ps_supplycost * ps_availqty) > (\n\
\ select\n\
\ sum(ps_supplycost * ps_availqty) * 0.0001000000\n\
\ from\n\
\ partsupp,\n\
\ supplier,\n\
\ nation\n\
\ where\n\
\ ps_suppkey = s_suppkey\n\
\ and s_nationkey = n_nationkey\n\
\ and n_name = 'CHINA'\n\
\ )\n\
\ order by\n\
\ value desc")
,("Q12","\n\
\ select\n\
\ l_shipmode,\n\
\ sum(case\n\
\ when o_orderpriority = '1-URGENT'\n\
\ or o_orderpriority = '2-HIGH'\n\
\ then 1\n\
\ else 0\n\
\ end) as high_line_count,\n\
\ sum(case\n\
\ when o_orderpriority <> '1-URGENT'\n\
\ and o_orderpriority <> '2-HIGH'\n\
\ then 1\n\
\ else 0\n\
\ end) as low_line_count\n\
\ from\n\
\ orders,\n\
\ lineitem\n\
\ where\n\
\ o_orderkey = l_orderkey\n\
\ and l_shipmode in ('AIR', 'RAIL')\n\
\ and l_commitdate < l_receiptdate\n\
\ and l_shipdate < l_commitdate\n\
\ and l_receiptdate >= date '1994-01-01'\n\
\ and l_receiptdate < date '1994-01-01' + interval '1' year\n\
\ group by\n\
\ l_shipmode\n\
\ order by\n\
\ l_shipmode")
,("Q13","\n\
\ select\n\
\ c_count,\n\
\ count(*) as custdist\n\
\ from\n\
\ (\n\
\ select\n\
\ c_custkey,\n\
\ count(o_orderkey)\n\
\ from\n\
\ customer left outer join orders on\n\
\ c_custkey = o_custkey\n\
\ and o_comment not like '%pending%requests%'\n\
\ group by\n\
\ c_custkey\n\
\ ) as c_orders (c_custkey, c_count)\n\
\ group by\n\
\ c_count\n\
\ order by\n\
\ custdist desc,\n\
\ c_count desc")
,("Q14","\n\
\ select\n\
\ 100.00 * sum(case\n\
\ when p_type like 'PROMO%'\n\
\ then l_extendedprice * (1 - l_discount)\n\
\ else 0\n\
\ end) / sum(l_extendedprice * (1 - l_discount)) as promo_revenue\n\
\ from\n\
\ lineitem,\n\
\ part\n\
\ where\n\
\ l_partkey = p_partkey\n\
\ and l_shipdate >= date '1994-12-01'\n\
\ and l_shipdate < date '1994-12-01' + interval '1' month")
,("Q15","\n\
\ /*create view revenue0 (supplier_no, total_revenue) as\n\
\ select\n\
\ l_suppkey,\n\
\ sum(l_extendedprice * (1 - l_discount))\n\
\ from\n\
\ lineitem\n\
\ where\n\
\ l_shipdate >= date '1995-06-01'\n\
\ and l_shipdate < date '1995-06-01' + interval '3' month\n\
\ group by\n\
\ l_suppkey;*/\n\
\ with\n\
\ revenue0 as\n\
\ (select\n\
\ l_suppkey as supplier_no,\n\
\ sum(l_extendedprice * (1 - l_discount)) as total_revenue\n\
\ from\n\
\ lineitem\n\
\ where\n\
\ l_shipdate >= date '1995-06-01'\n\
\ and l_shipdate < date '1995-06-01' + interval '3' month\n\
\ group by\n\
\ l_suppkey)\n\
\ select\n\
\ s_suppkey,\n\
\ s_name,\n\
\ s_address,\n\
\ s_phone,\n\
\ total_revenue\n\
\ from\n\
\ supplier,\n\
\ revenue0\n\
\ where\n\
\ s_suppkey = supplier_no\n\
\ and total_revenue = (\n\
\ select\n\
\ max(total_revenue)\n\
\ from\n\
\ revenue0\n\
\ )\n\
\ order by\n\
\ s_suppkey")
,("Q16","\n\
\ select\n\
\ p_brand,\n\
\ p_type,\n\
\ p_size,\n\
\ count(distinct ps_suppkey) as supplier_cnt\n\
\ from\n\
\ partsupp,\n\
\ part\n\
\ where\n\
\ p_partkey = ps_partkey\n\
\ and p_brand <> 'Brand#15'\n\
\ and p_type not like 'MEDIUM BURNISHED%'\n\
\ and p_size in (39, 26, 18, 45, 19, 1, 3, 9)\n\
\ and ps_suppkey not in (\n\
\ select\n\
\ s_suppkey\n\
\ from\n\
\ supplier\n\
\ where\n\
\ s_comment like '%Customer%Complaints%'\n\
\ )\n\
\ group by\n\
\ p_brand,\n\
\ p_type,\n\
\ p_size\n\
\ order by\n\
\ supplier_cnt desc,\n\
\ p_brand,\n\
\ p_type,\n\
\ p_size")
,("Q17","\n\
\ select\n\
\ sum(l_extendedprice) / 7.0 as avg_yearly\n\
\ from\n\
\ lineitem,\n\
\ part\n\
\ where\n\
\ p_partkey = l_partkey\n\
\ and p_brand = 'Brand#52'\n\
\ and p_container = 'JUMBO CAN'\n\
\ and l_quantity < (\n\
\ select\n\
\ 0.2 * avg(l_quantity)\n\
\ from\n\
\ lineitem\n\
\ where\n\
\ l_partkey = p_partkey\n\
\ )")
,("Q18","\n\
\ select\n\
\ c_name,\n\
\ c_custkey,\n\
\ o_orderkey,\n\
\ o_orderdate,\n\
\ o_totalprice,\n\
\ sum(l_quantity)\n\
\ from\n\
\ customer,\n\
\ orders,\n\
\ lineitem\n\
\ where\n\
\ o_orderkey in (\n\
\ select\n\
\ l_orderkey\n\
\ from\n\
\ lineitem\n\
\ group by\n\
\ l_orderkey having\n\
\ sum(l_quantity) > 313\n\
\ )\n\
\ and c_custkey = o_custkey\n\
\ and o_orderkey = l_orderkey\n\
\ group by\n\
\ c_name,\n\
\ c_custkey,\n\
\ o_orderkey,\n\
\ o_orderdate,\n\
\ o_totalprice\n\
\ order by\n\
\ o_totalprice desc,\n\
\ o_orderdate\n\
\ fetch first 100 rows only")
,("Q19","\n\
\ select\n\
\ sum(l_extendedprice* (1 - l_discount)) as revenue\n\
\ from\n\
\ lineitem,\n\
\ part\n\
\ where\n\
\ (\n\
\ p_partkey = l_partkey\n\
\ and p_brand = 'Brand#43'\n\
\ and p_container in ('SM CASE', 'SM BOX', 'SM PACK', 'SM PKG')\n\
\ and l_quantity >= 3 and l_quantity <= 3 + 10\n\
\ and p_size between 1 and 5\n\
\ and l_shipmode in ('AIR', 'AIR REG')\n\
\ and l_shipinstruct = 'DELIVER IN PERSON'\n\
\ )\n\
\ or\n\
\ (\n\
\ p_partkey = l_partkey\n\
\ and p_brand = 'Brand#25'\n\
\ and p_container in ('MED BAG', 'MED BOX', 'MED PKG', 'MED PACK')\n\
\ and l_quantity >= 10 and l_quantity <= 10 + 10\n\
\ and p_size between 1 and 10\n\
\ and l_shipmode in ('AIR', 'AIR REG')\n\
\ and l_shipinstruct = 'DELIVER IN PERSON'\n\
\ )\n\
\ or\n\
\ (\n\
\ p_partkey = l_partkey\n\
\ and p_brand = 'Brand#24'\n\
\ and p_container in ('LG CASE', 'LG BOX', 'LG PACK', 'LG PKG')\n\
\ and l_quantity >= 22 and l_quantity <= 22 + 10\n\
\ and p_size between 1 and 15\n\
\ and l_shipmode in ('AIR', 'AIR REG')\n\
\ and l_shipinstruct = 'DELIVER IN PERSON'\n\
\ )")
,("Q20","\n\
\ select\n\
\ s_name,\n\
\ s_address\n\
\ from\n\
\ supplier,\n\
\ nation\n\
\ where\n\
\ s_suppkey in (\n\
\ select\n\
\ ps_suppkey\n\
\ from\n\
\ partsupp\n\
\ where\n\
\ ps_partkey in (\n\
\ select\n\
\ p_partkey\n\
\ from\n\
\ part\n\
\ where\n\
\ p_name like 'lime%'\n\
\ )\n\
\ and ps_availqty > (\n\
\ select\n\
\ 0.5 * sum(l_quantity)\n\
\ from\n\
\ lineitem\n\
\ where\n\
\ l_partkey = ps_partkey\n\
\ and l_suppkey = ps_suppkey\n\
\ and l_shipdate >= date '1994-01-01'\n\
\ and l_shipdate < date '1994-01-01' + interval '1' year\n\
\ )\n\
\ )\n\
\ and s_nationkey = n_nationkey\n\
\ and n_name = 'VIETNAM'\n\
\ order by\n\
\ s_name")
,("Q21","\n\
\ select\n\
\ s_name,\n\
\ count(*) as numwait\n\
\ from\n\
\ supplier,\n\
\ lineitem l1,\n\
\ orders,\n\
\ nation\n\
\ where\n\
\ s_suppkey = l1.l_suppkey\n\
\ and o_orderkey = l1.l_orderkey\n\
\ and o_orderstatus = 'F'\n\
\ and l1.l_receiptdate > l1.l_commitdate\n\
\ and exists (\n\
\ select\n\
\ *\n\
\ from\n\
\ lineitem l2\n\
\ where\n\
\ l2.l_orderkey = l1.l_orderkey\n\
\ and l2.l_suppkey <> l1.l_suppkey\n\
\ )\n\
\ and not exists (\n\
\ select\n\
\ *\n\
\ from\n\
\ lineitem l3\n\
\ where\n\
\ l3.l_orderkey = l1.l_orderkey\n\
\ and l3.l_suppkey <> l1.l_suppkey\n\
\ and l3.l_receiptdate > l3.l_commitdate\n\
\ )\n\
\ and s_nationkey = n_nationkey\n\
\ and n_name = 'INDIA'\n\
\ group by\n\
\ s_name\n\
\ order by\n\
\ numwait desc,\n\
\ s_name\n\
\ fetch first 100 rows only")
,("Q22","\n\
\ select\n\
\ cntrycode,\n\
\ count(*) as numcust,\n\
\ sum(c_acctbal) as totacctbal\n\
\ from\n\
\ (\n\
\ select\n\
\ substring(c_phone from 1 for 2) as cntrycode,\n\
\ c_acctbal\n\
\ from\n\
\ customer\n\
\ where\n\
\ substring(c_phone from 1 for 2) in\n\
\ ('41', '28', '39', '21', '24', '29', '44')\n\
\ and c_acctbal > (\n\
\ select\n\
\ avg(c_acctbal)\n\
\ from\n\
\ customer\n\
\ where\n\
\ c_acctbal > 0.00\n\
\ and substring(c_phone from 1 for 2) in\n\
\ ('41', '28', '39', '21', '24', '29', '44')\n\
\ )\n\
\ and not exists (\n\
\ select\n\
\ *\n\
\ from\n\
\ orders\n\
\ where\n\
\ o_custkey = c_custkey\n\
\ )\n\
\ ) as custsale\n\
\ group by\n\
\ cntrycode\n\
\ order by\n\
\ cntrycode")
]