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

switch tests to hspec, improve error messages

Browse source
This commit is contained in:
Jake Wheat 2024-02-04 16:00:59 +00:00
parent fadd010942
commit c11bee4a9c
36 changed files with 2570 additions and 1809 deletions

10
tests/Language/SQL/SimpleSQL/CreateIndex.hs
View file

@ -4,15 +4,19 @@ module Language.SQL.SimpleSQL.CreateIndex where
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
createIndexTests :: TestItem
createIndexTests = Group "create index tests"
[TestStatement ansi2011 "create index a on tbl(c1)"
[s "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)"
,s "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)"
,s "create unique index a on tbl(c1)"
$ CreateIndex True [nm "a"] [nm "tbl"] [nm "c1"]
]
where
nm = Name Nothing
s :: HasCallStack => Text -> Statement -> TestItem
s src ast = testStatement ansi2011 src ast

38
tests/Language/SQL/SimpleSQL/CustomDialect.hs
View file

@ -3,26 +3,30 @@
module Language.SQL.SimpleSQL.CustomDialect (customDialectTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
customDialectTests :: TestItem
customDialectTests = Group "custom dialect tests" (map (uncurry ParseQueryExpr) passTests
++ map (uncurry ParseScalarExprFails) failTests )
customDialectTests = Group "custom dialect tests" $
[q ansi2011 "SELECT a b"
,q noDateKeyword "SELECT DATE('2000-01-01')"
,q noDateKeyword "SELECT DATE"
,q dateApp "SELECT DATE('2000-01-01')"
,q dateIden "SELECT DATE"
,f ansi2011 "SELECT DATE('2000-01-01')"
,f ansi2011 "SELECT DATE"
,f dateApp "SELECT DATE"
,f dateIden "SELECT DATE('2000-01-01')"
-- show this never being allowed as an alias
,f ansi2011 "SELECT a date"
,f dateApp "SELECT a date"
,f dateIden "SELECT a date"
]
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}
q :: HasCallStack => Dialect -> Text -> TestItem
q d src = testParseQueryExpr d src
f :: HasCallStack => Dialect -> Text -> TestItem
f d src = testParseQueryExprFails d src

27
tests/Language/SQL/SimpleSQL/EmptyStatement.hs
View file

@ -3,19 +3,26 @@ module Language.SQL.SimpleSQL.EmptyStatement where
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
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 */ ;"
[ s ";" EmptyStatement
, t ";" [EmptyStatement]
, t ";;" [EmptyStatement, EmptyStatement]
, t ";;;" [EmptyStatement, EmptyStatement, EmptyStatement]
, s "/* comment */ ;" EmptyStatement
, t "" []
, t "/* comment */" []
, t "/* comment */ ;" [EmptyStatement]
, t "/* comment */ ; /* comment */ ;"
[EmptyStatement, EmptyStatement]
, TestStatements ansi2011 "/* comment */ ; /* comment */ ; /* comment */ ;"
, t "/* comment */ ; /* comment */ ; /* comment */ ;"
[EmptyStatement, EmptyStatement, EmptyStatement]
]
where
s :: HasCallStack => Text -> Statement -> TestItem
s src a = testStatement ansi2011 src a
t :: HasCallStack => Text -> [Statement] -> TestItem
t src a = testStatements ansi2011 src a

216
tests/Language/SQL/SimpleSQL/ErrorMessages.hs
View file

@ -1,156 +1,82 @@
{-
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.
See the file examples/ErrorMessagesTool.hs for some work on this
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"
add simple test to check the error and quoting on later line in multi
line input for lexing and parsing; had a regression here that made it
to a release
{-
casts
subqueries: + whole set of parentheses use
in list
'keyword' functions
aggregates
window functions
-}
]
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
module Language.SQL.SimpleSQL.ErrorMessages
(errorMessageTests
) where
queryExpressions :: [String]
queryExpressions =
map sl1 valueExpressions
++ map sl2 valueExpressions
++ map sl3 valueExpressions
++
["select a from t inner jin u"]
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Parse
import qualified Language.SQL.SimpleSQL.Lex as L
import Language.SQL.SimpleSQL.TestRunners
--import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.Expectations
import Test.Hspec (it)
import Debug.Trace
import Data.Text (Text)
import qualified Data.Text as T
import qualified Text.RawString.QQ as R
errorMessageTests :: TestItem
errorMessageTests = Group "error messages"
[gp (parseQueryExpr ansi2011 "" Nothing) prettyError [R.r|
select
a
from t
where
something
order by 1,2,3 where
|]
[R.r|8:16:
|
8 | order by 1,2,3 where
| ^^^^^
unexpected where
|]
,gp (L.lexSQL ansi2011 False "" Nothing) L.prettyError [R.r|
select
a
from t
where
something
order by 1,2,3 $@
|]
[R.r|8:16:
|
8 | order by 1,2,3 $@
| ^
unexpected '$'
|]
]
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
-}
gp :: (Show a, HasCallStack) => (Text -> Either e a) -> (e -> Text) -> Text -> Text -> TestItem
gp parse pret src err =
GeneralParseFailTest src err $
it (T.unpack src) $
let f1 = parse src
ex = shouldFailWith pret
quickTrace =
case f1 of
Left f | pret f /= err ->
trace (T.unpack ("check\n[" <> pret f <>"]\n["<> err <> "]\n"))
_ -> id
in quickTrace (f1 `ex` err)

61
tests/Language/SQL/SimpleSQL/Expectations.hs Normal file
View file

@ -0,0 +1,61 @@
module Language.SQL.SimpleSQL.Expectations
(shouldParseA
,shouldParseL
,shouldParse1
,shouldFail
,shouldSucceed
,shouldFailWith
) where
import Language.SQL.SimpleSQL.Parse
import qualified Language.SQL.SimpleSQL.Lex as Lex
import qualified Data.Text as T
import Data.Text (Text)
import Test.Hspec.Expectations
(Expectation
,HasCallStack
,expectationFailure
)
import Test.Hspec
(shouldBe
)
shouldParseA :: (HasCallStack,Eq a, Show a) => Either ParseError a -> a -> Expectation
shouldParseA = shouldParse1 (T.unpack . prettyError)
shouldParseL :: (HasCallStack,Eq a, Show a) => Either Lex.ParseError a -> a -> Expectation
shouldParseL = shouldParse1 (T.unpack . Lex.prettyError)
shouldParse1 :: (HasCallStack, Show a, Eq a) =>
(e -> String)
-> Either e a
-> a
-> Expectation
shouldParse1 prettyErr r v = case r of
Left e ->
expectationFailure $
"expected: "
++ show v
++ "\nbut parsing failed with error:\n"
++ prettyErr e
Right x -> x `shouldBe` v
shouldFail :: (HasCallStack, Show a) => Either e a -> Expectation
shouldFail r = case r of
Left _ -> (1 :: Int) `shouldBe` 1
Right a -> expectationFailure $ "expected parse failure, but succeeded with " <> show a
shouldFailWith :: (HasCallStack, Show a) => (e -> Text) -> Either e a -> Text -> Expectation
shouldFailWith p r e = case r of
Left e1 -> p e1 `shouldBe` e
Right a -> expectationFailure $ "expected parse failure, but succeeded with " <> show a
shouldSucceed :: (HasCallStack) => (e -> String) -> Either e a -> Expectation
shouldSucceed pe r = case r of
Left e -> expectationFailure $ "expected parse success, but got: " <> pe e
Right _ -> (1 :: Int) `shouldBe` 1

19
tests/Language/SQL/SimpleSQL/FullQueries.hs
View file

@ -6,24 +6,24 @@ module Language.SQL.SimpleSQL.FullQueries (fullQueriesTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
fullQueriesTests :: TestItem
fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))
[("select count(*) from t"
,toQueryExpr $ makeSelect
fullQueriesTests = Group "queries" $
[q "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\
,q "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
$ toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "a"], Nothing)
,(App [Name Nothing "sum"]
[BinOp (Iden [Name Nothing "c"])
@ -36,5 +36,8 @@ fullQueriesTests = Group "queries" $ map (uncurry (TestQueryExpr ansi2011))
[Name Nothing ">"] (NumLit "5")
,msOrderBy = [SortSpec (Iden [Name Nothing "s"]) DirDefault NullsOrderDefault]
}
)
]
where
q :: HasCallStack => Text -> QueryExpr -> TestItem
q src a = testQueryExpr ansi2011 src a

124
tests/Language/SQL/SimpleSQL/GroupBy.hs
View file

@ -6,6 +6,8 @@ module Language.SQL.SimpleSQL.GroupBy (groupByTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
groupByTests :: TestItem
@ -15,23 +17,31 @@ groupByTests = Group "groupByTests"
,randomGroupBy
]
q :: HasCallStack => Text -> QueryExpr -> TestItem
q src a = testQueryExpr ansi2011 src a
p :: HasCallStack => Text -> TestItem
p src = testParseQueryExpr ansi2011 src
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)
simpleGroupBy = Group "simpleGroupBy"
[q "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)
,q "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"]]
})
}
]
{-
@ -40,15 +50,15 @@ 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"]]])
newGroupBy = Group "newGroupBy"
[q "select * from t group by ()" $ ms [GroupingParens []]
,q "select * from t group by grouping sets ((), (a))"
$ ms [GroupingSets [GroupingParens []
,GroupingParens [SimpleGroup $ Iden [Name Nothing "a"]]]]
,q "select * from t group by cube(a,b)"
$ ms [Cube [SimpleGroup $ Iden [Name Nothing "a"], SimpleGroup $ Iden [Name Nothing "b"]]]
,q "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)]
@ -56,21 +66,21 @@ newGroupBy = Group "newGroupBy" $ map (uncurry (TestQueryExpr ansi2011))
,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\
randomGroupBy = Group "randomGroupBy"
[p "select * from t GROUP BY a"
,p "select * from t GROUP BY GROUPING SETS((a))"
,p "select * from t GROUP BY a,b,c"
,p "select * from t GROUP BY GROUPING SETS((a,b,c))"
,p "select * from t GROUP BY ROLLUP(a,b)"
,p "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\
,p "select * from t GROUP BY ROLLUP(b,a)"
,p "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\
,p "select * from t GROUP BY CUBE(a,b,c)"
,p "select * from t GROUP BY GROUPING SETS((a,b,c),\n\
\(a,b),\n\
\(a,c),\n\
\(b,c),\n\
@ -78,33 +88,33 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\(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\
,p "select * from t GROUP BY ROLLUP(Province, County, City)"
,p "select * from t GROUP BY ROLLUP(Province, (County, City))"
,p "select * from t GROUP BY ROLLUP(Province, (County, City))"
,p "select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
\(Province),\n\
\() )"
,"select * from t GROUP BY GROUPING SETS((Province, County, City),\n\
,p "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\
,p "select * from t GROUP BY a, ROLLUP(b,c)"
,p "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\
,p "select * from t GROUP BY a, b, ROLLUP(c,d)"
,p "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\
,p "select * from t GROUP BY ROLLUP(a), ROLLUP(b,c)"
,p "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\
,p "select * from t GROUP BY ROLLUP(a), CUBE(b,c)"
,p "select * from t GROUP BY GROUPING SETS((a,b,c),\n\
\(a,b),\n\
\(a,c),\n\
\(a),\n\
@ -112,8 +122,8 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\(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\
,p "select * from t GROUP BY CUBE(a,b), ROLLUP(c,d)"
,p "select * from t GROUP BY GROUPING SETS((a,b,c,d),\n\
\(a,b,c),\n\
\(a,b),\n\
\(a,c,d),\n\
@ -125,16 +135,16 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\(c,d),\n\
\(c),\n\
\() )"
,"select * from t GROUP BY a, ROLLUP(a,b)"
,"select * from t GROUP BY GROUPING SETS((a,b),\n\
,p "select * from t GROUP BY a, ROLLUP(a,b)"
,p "select * from t GROUP BY GROUPING SETS((a,b),\n\
\(a) )"
,"select * from t GROUP BY Region,\n\
,p "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\
,p "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\
,p "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\
@ -142,7 +152,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\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\
,p "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\
@ -151,7 +161,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\(DAYOFWEEK(SALES_DATE), SALES_PERSON))\n\
\ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
,p "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\
@ -159,7 +169,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\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\
,p "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\
@ -167,7 +177,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\GROUP BY CUBE ( WEEK(SALES_DATE), DAYOFWEEK(SALES_DATE), SALES_PERSON )\n\
\ORDER BY WEEK, DAY_WEEK, SALES_PERSON"
,"SELECT SALES_PERSON,\n\
,p "SELECT SALES_PERSON,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
\SUM(SALES) AS UNITS_SOLD\n\
\FROM SALES\n\
@ -176,21 +186,21 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\)\n\
\ORDER BY SALES_PERSON, MONTH"
,"SELECT WEEK(SALES_DATE) AS WEEK,\n\
,p "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\
,p "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\
,p "SELECT WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
\REGION,\n\
@ -200,7 +210,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\ROLLUP( MONTH(SALES_DATE), REGION ) )\n\
\ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
,"SELECT R1, R2,\n\
,p "SELECT R1, R2,\n\
\WEEK(SALES_DATE) AS WEEK,\n\
\DAYOFWEEK(SALES_DATE) AS DAY_WEEK,\n\
\MONTH(SALES_DATE) AS MONTH,\n\
@ -211,7 +221,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
\(R2,ROLLUP( MONTH(SALES_DATE), REGION ) ))\n\
\ORDER BY WEEK, DAY_WEEK, MONTH, REGION"
{-,"SELECT COALESCE(R1,R2) AS GROUP,\n\
{-,p "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\
@ -226,7 +236,7 @@ randomGroupBy = Group "randomGroupBy" $ map (ParseQueryExpr ansi2011)
-- 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\
,p "SELECT MONTH(SALES_DATE) AS MONTH,\n\
\REGION,\n\
\SUM(SALES) AS UNITS_SOLD,\n\
\MAX(SALES) AS BEST_SALE,\n\

206
tests/Language/SQL/SimpleSQL/LexerTests.hs
View file

@ -23,6 +23,7 @@ import Language.SQL.SimpleSQL.Lex
(Token(..)
,tokenListWillPrintAndLex
)
import Language.SQL.SimpleSQL.TestRunners
import qualified Data.Text as T
import Data.Text (Text)
@ -39,50 +40,57 @@ lexerTests = Group "lexerTests" $
,sqlServerLexerTests
,oracleLexerTests
,mySqlLexerTests
,odbcLexerTests]
,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"])
bootstrapTests = Group "bootstrap tests" $
[t "iden" [Identifier Nothing "iden"]
,(" ", [Whitespace " "])
,("\t ", [Whitespace "\t "])
,(" \n ", [Whitespace " \n "])
,t "\"a1normal \"\" iden\"" [Identifier (Just ("\"","\"")) "a1normal \"\" iden"]
,("--", [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"])
,t "'string'" [SqlString "'" "'" "string"]
,("/*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"])
,t " " [Whitespace " "]
,t "\t " [Whitespace "\t "]
,t " \n " [Whitespace " \n "]
,t "--" [LineComment "--"]
,t "--\n" [LineComment "--\n"]
,t "--stuff" [LineComment "--stuff"]
,t "-- stuff" [LineComment "-- stuff"]
,t "-- stuff\n" [LineComment "-- stuff\n"]
,t "--\nstuff" [LineComment "--\n", Identifier Nothing "stuff"]
,t "-- com \nstuff" [LineComment "-- com \n", Identifier Nothing "stuff"]
,("1", [SqlNumber "1"])
,("42", [SqlNumber "42"])
,t "/*test1*/" [BlockComment "/*test1*/"]
,t "/**/" [BlockComment "/**/"]
,t "/***/" [BlockComment "/***/"]
,t "/* * */" [BlockComment "/* * */"]
,t "/*test*/" [BlockComment "/*test*/"]
,t "/*te/*st*/*/" [BlockComment "/*te/*st*/*/"]
,t "/*te*st*/" [BlockComment "/*te*st*/"]
,t "/*lines\nmore lines*/" [BlockComment "/*lines\nmore lines*/"]
,t "/*test1*/\n" [BlockComment "/*test1*/", Whitespace "\n"]
,t "/*test1*/stuff" [BlockComment "/*test1*/", Identifier Nothing "stuff"]
-- have to fix the dialect handling in the tests
--,("$1", [PositionalArg 1])
--,("$200", [PositionalArg 200])
,t "1" [SqlNumber "1"]
,t "42" [SqlNumber "42"]
,(":test", [PrefixedVariable ':' "test"])
,tp "$1" [PositionalArg 1]
,tp "$200" [PositionalArg 200]
] ++ map (\a -> (a, [Symbol a])) (
,t ":test" [PrefixedVariable ':' "test"]
] ++ map (\a -> t a [Symbol a]) (
["!=", "<>", ">=", "<=", "||"]
++ map T.singleton ("(),-+*/<>=." :: [Char])))]
++ map T.singleton ("(),-+*/<>=." :: [Char]))
where
t :: HasCallStack => Text -> [Token] -> TestItem
t src ast = testLex ansi2011 src ast
tp :: HasCallStack => Text -> [Token] -> TestItem
tp src ast = testLex ansi2011{diPositionalArg=True} src ast
ansiLexerTable :: [(Text,[Token])]
@ -103,7 +111,7 @@ ansiLexerTable =
)
-- quoted identifiers with embedded double quotes
-- the lexer doesn't unescape the quotes
++ [("\"normal \"\" iden\"", [Identifier (Just ("\"","\"")) "normal \"\" iden"])]
++ [("\"anormal \"\" iden\"", [Identifier (Just ("\"","\"")) "anormal \"\" iden"])]
-- strings
-- the lexer doesn't apply escapes at all
++ [("'string'", [SqlString "'" "'" "string"])
@ -137,39 +145,44 @@ ansiLexerTable =
ansiLexerTests :: TestItem
ansiLexerTests = Group "ansiLexerTests" $
[Group "ansi lexer token tests" $ [LexTest ansi2011 s t | (s,t) <- ansiLexerTable]
[Group "ansi lexer token tests" $ [l 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
[ l (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"]
]
[l "" []
,l "-- line com\nstuff" [LineComment "-- line com\n",Identifier Nothing "stuff"]
] ++
[-- want to make sure this gives a parse error
f "*/"
-- combinations of pipes: make sure they fail because they could be
-- ambiguous and it is really unclear when they are or not, and
-- what the result is even when they are not ambiguous
,f "|||"
,f "||||"
,f "|||||"
-- another user experience thing: make sure extra trailing
-- number chars are rejected rather than attempting to parse
-- if the user means to write something that is rejected by this code,
-- then they can use whitespace to make it clear and then it will parse
,f "12e3e4"
,f "12e3e4"
,f "12e3e4"
,f "12e3.4"
,f "12.4.5"
,f "12.4e5.6"
,f "12.4e5e7"]
]
where
l :: HasCallStack => Text -> [Token] -> TestItem
l src ast = testLex ansi2011 src ast
f :: HasCallStack => Text -> TestItem
f src = lexFails ansi2011 src
{-
todo: lexing tests
@ -303,22 +316,21 @@ somePostgresOpsWhichWontAddTrailingPlusMinus l =
, not (T.last x `T.elem` "+-")
]
postgresLexerTests :: TestItem
postgresLexerTests = Group "postgresLexerTests" $
[Group "postgres lexer token tests" $
[LexTest postgres s t | (s,t) <- postgresLexerTable]
[l s t | (s,t) <- postgresLexerTable]
,Group "postgres generated lexer token tests" $
[LexTest postgres s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]
[l s t | (s,t) <- postgresShortOperatorTable ++ postgresExtraOperatorTable]
,Group "postgres generated combination lexer tests" $
[ LexTest postgres (s <> s1) (t <> t1)
[ l (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
[l s t
| (s,t) <- edgeCaseCommentOps
++ edgeCasePlusMinusOps
++ edgeCasePlusMinusComments]
@ -326,22 +338,23 @@ postgresLexerTests = Group "postgresLexerTests" $
,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"
[f "*/"
,f ":::"
,f "::::"
,f ":::::"
,f "@*/"
,f "-*/"
,f "12e3e4"
,f "12e3e4"
,f "12e3e4"
,f "12e3.4"
,f "12.4.5"
,f "12.4e5.6"
,f "12.4e5e7"
-- 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"]]
,l "1..2" [SqlNumber "1", Symbol "..", SqlNumber "2"]
]
]
where
edgeCaseCommentOps =
@ -365,14 +378,21 @@ postgresLexerTests = Group "postgresLexerTests" $
,("-/**/", [Symbol "-", BlockComment "/**/"])
,("+/**/", [Symbol "+", BlockComment "/**/"])
]
l :: HasCallStack => Text -> [Token] -> TestItem
l src ast = testLex postgres src ast
f :: HasCallStack => Text -> TestItem
f src = lexFails postgres src
sqlServerLexerTests :: TestItem
sqlServerLexerTests = Group "sqlServerLexTests" $
[ LexTest sqlserver s t | (s,t) <-
[l s t | (s,t) <-
[("@variable", [(PrefixedVariable '@' "variable")])
,("#variable", [(PrefixedVariable '#' "variable")])
,("[quoted identifier]", [(Identifier (Just ("[", "]")) "quoted identifier")])
]]
where
l :: HasCallStack => Text -> [Token] -> TestItem
l src ast = testLex sqlserver src ast
oracleLexerTests :: TestItem
oracleLexerTests = Group "oracleLexTests" $
@ -380,19 +400,29 @@ oracleLexerTests = Group "oracleLexTests" $
mySqlLexerTests :: TestItem
mySqlLexerTests = Group "mySqlLexerTests" $
[ LexTest mysql s t | (s,t) <-
[ l s t | (s,t) <-
[("`quoted identifier`", [(Identifier (Just ("`", "`")) "quoted identifier")])
]
]
where
l :: HasCallStack => Text -> [Token] -> TestItem
l src ast = testLex mysql src ast
odbcLexerTests :: TestItem
odbcLexerTests = Group "odbcLexTests" $
[ LexTest sqlserver {diOdbc = True} s t | (s,t) <-
[ lo s t | (s,t) <-
[("{}", [Symbol "{", Symbol "}"])
]]
++ [LexFails sqlserver {diOdbc = False} "{"
,LexFails sqlserver {diOdbc = False} "}"]
++ [lno "{"
,lno "}"]
where
lo :: HasCallStack => Text -> [Token] -> TestItem
lo src ast = testLex (sqlserver {diOdbc = True}) src ast
lno :: HasCallStack => Text -> TestItem
lno src = lexFails (sqlserver{diOdbc = False}) src
combos :: [Char] -> Int -> [Text]
combos _ 0 = [T.empty]
combos l n = [ T.cons x tl | x <- l, tl <- combos l (n - 1) ]

22
tests/Language/SQL/SimpleSQL/MySQL.hs
View file

@ -6,6 +6,7 @@ module Language.SQL.SimpleSQL.MySQL (mySQLTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
mySQLTests :: TestItem
mySQLTests = Group "mysql dialect"
@ -21,21 +22,16 @@ limit syntax
-}
backtickQuotes :: TestItem
backtickQuotes = Group "backtickQuotes" (map (uncurry (TestScalarExpr mysql))
[("`test`", Iden [Name (Just ("`","`")) "test"])
]
++ [ParseScalarExprFails ansi2011 "`test`"]
)
backtickQuotes = Group "backtickQuotes"
[testScalarExpr mysql "`test`" $ Iden [Name (Just ("`","`")) "test"]
,testParseScalarExprFails 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"]
)
limit = Group "queries"
[testQueryExpr mysql "select * from t limit 5"
$ toQueryExpr $ sel {msFetchFirst = Just (NumLit "5")}
,testParseQueryExprFails mysql "select a from t fetch next 10 rows only;"
,testParseQueryExprFails ansi2011 "select * from t limit 5"]
where
sel = makeSelect
{msSelectList = [(Star, Nothing)]

13
tests/Language/SQL/SimpleSQL/Odbc.hs
View file

@ -4,6 +4,8 @@ module Language.SQL.SimpleSQL.Odbc (odbcTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
odbcTests :: TestItem
odbcTests = Group "odbc" [
@ -30,14 +32,14 @@ odbcTests = Group "odbc" [
,iden "SQL_DATE"])
]
,Group "outer join" [
TestQueryExpr ansi2011 {diOdbc=True}
q
"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}
q
"select {fn CONVERT(cint,SQL_BIGINT)} from t;"
$ toQueryExpr $ makeSelect
{msSelectList = [(OdbcFunc (ap "CONVERT"
@ -46,7 +48,12 @@ odbcTests = Group "odbc" [
,msFrom = [TRSimple [Name Nothing "t"]]}]
]
where
e = TestScalarExpr ansi2011 {diOdbc = True}
e :: HasCallStack => Text -> ScalarExpr -> TestItem
e src ast = testScalarExpr ansi2011{diOdbc = True} src ast
q :: HasCallStack => Text -> QueryExpr -> TestItem
q src ast = testQueryExpr ansi2011{diOdbc = True} src ast
--tsql = ParseProcSql defaultParseFlags {pfDialect=sqlServerDialect}
ap n = App [Name Nothing n]
iden n = Iden [Name Nothing n]

23
tests/Language/SQL/SimpleSQL/Oracle.hs
View file

@ -6,6 +6,7 @@ module Language.SQL.SimpleSQL.Oracle (oracleTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
oracleTests :: TestItem
oracleTests = Group "oracle dialect"
@ -13,18 +14,18 @@ oracleTests = Group "oracle dialect"
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
oracleLobUnits = Group "oracleLobUnits"
[testScalarExpr oracle "cast (a as varchar2(3 char))"
$ Cast (Iden [Name Nothing "a"]) (
PrecLengthTypeName [Name Nothing "varchar2"] 3 Nothing (Just PrecCharacters))
,testScalarExpr oracle "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 []]]
)
Nothing []]
]

151
tests/Language/SQL/SimpleSQL/Postgres.hs
View file

@ -9,9 +9,11 @@ revisited when the dialect support is added.
module Language.SQL.SimpleSQL.Postgres (postgresTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
postgresTests :: TestItem
postgresTests = Group "postgresTests" $ map (ParseQueryExpr ansi2011)
postgresTests = Group "postgresTests"
{-
lexical syntax section
@ -22,129 +24,129 @@ 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\
t "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');"
,t "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));"
,t "SELECT ROW(t.*, 42) FROM t;"
,t "SELECT ROW(t.f1, t.f2, 42) FROM t;"
,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');"
,t "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;"
--,t "SELECT ROW(table.*) IS NULL FROM table;"
,t "SELECT ROW(tablex.*) IS NULL FROM tablex;"
,"SELECT true OR somefunc();"
,t "SELECT true OR somefunc();"
,"SELECT somefunc() OR true;"
,t "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';"
,t "SELECT * FROM t1 CROSS JOIN t2;"
,t "SELECT * FROM t1 INNER JOIN t2 ON t1.num = t2.num;"
,t "SELECT * FROM t1 INNER JOIN t2 USING (num);"
,t "SELECT * FROM t1 NATURAL INNER JOIN t2;"
,t "SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num;"
,t "SELECT * FROM t1 LEFT JOIN t2 USING (num);"
,t "SELECT * FROM t1 RIGHT JOIN t2 ON t1.num = t2.num;"
,t "SELECT * FROM t1 FULL JOIN t2 ON t1.num = t2.num;"
,t "SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num AND t2.value = 'xxx';"
,t "SELECT * FROM t1 LEFT JOIN t2 ON t1.num = t2.num WHERE t2.value = 'xxx';"
,"SELECT * FROM some_very_long_table_name s\n\
,t "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\
,t "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\
,t "SELECT * FROM my_table AS a CROSS JOIN my_table AS b;"
,t "SELECT * FROM (my_table AS a CROSS JOIN my_table) AS b;"
,t "SELECT * FROM getfoo(1) AS t1;"
,t "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\
{-,t "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;"
,t "SELECT * FROM foo, LATERAL (SELECT * FROM bar WHERE bar.id = foo.bar_id) ss;"
,t "SELECT * FROM foo, bar WHERE bar.id = foo.bar_id;"
{-,"SELECT p1.id, p2.id, v1, v2\n\
{-,t "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\
{-,t "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\
,t "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"
,t "SELECT * FROM fdt WHERE c1 > 5"
,"SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"
,t "SELECT * FROM fdt WHERE c1 IN (1, 2, 3)"
,"SELECT * FROM fdt WHERE c1 IN (SELECT c1 FROM t2)"
,t "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)"
,t "SELECT * FROM fdt WHERE c1 IN (SELECT c3 FROM t2 WHERE c2 = fdt.c1 + 10)"
,"SELECT * FROM fdt WHERE c1 BETWEEN \n\
,t "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)"
,t "SELECT * FROM fdt WHERE EXISTS (SELECT c1 FROM t2 WHERE c2 > fdt.c1)"
,"SELECT * FROM test1;"
,t "SELECT * FROM test1;"
,"SELECT x FROM test1 GROUP BY x;"
,"SELECT x, sum(y) FROM test1 GROUP BY x;"
,t "SELECT x FROM test1 GROUP BY x;"
,t "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\
,t "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\
,t "SELECT x, sum(y) FROM test1 GROUP BY x HAVING sum(y) > 3;"
,t "SELECT x, sum(y) FROM test1 GROUP BY x HAVING x < 'c';"
,t "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"
,t "SELECT a, b, c FROM t"
,"SELECT tbl1.a, tbl2.a, tbl1.b FROM t"
,t "SELECT tbl1.a, tbl2.a, tbl1.b FROM t"
,"SELECT tbl1.*, tbl2.a FROM t"
,t "SELECT tbl1.*, tbl2.a FROM t"
,"SELECT a AS value, b + c AS sum FROM t"
,t "SELECT a AS value, b + c AS sum FROM t"
,"SELECT a \"value\", b + c AS sum FROM t"
,t "SELECT a \"value\", b + c AS sum FROM t"
,"SELECT DISTINCT select_list t"
,t "SELECT DISTINCT select_list t"
,"VALUES (1, 'one'), (2, 'two'), (3, 'three');"
,t "VALUES (1, 'one'), (2, 'two'), (3, 'three');"
,"SELECT 1 AS column1, 'one' AS column2\n\
,t "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);"
,t "SELECT * FROM (VALUES (1, 'one'), (2, 'two'), (3, 'three')) AS t (num,letter);"
,"WITH regional_sales AS (\n\
,t "WITH regional_sales AS (\n\
\ SELECT region, SUM(amount) AS total_sales\n\
\ FROM orders\n\
\ GROUP BY region\n\
@ -161,14 +163,14 @@ TODO: get all the commented out tests working
\WHERE region IN (SELECT region FROM top_regions)\n\
\GROUP BY region, product;"
,"WITH RECURSIVE t(n) AS (\n\
,t "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\
,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\
@ -179,7 +181,7 @@ TODO: get all the commented out tests working
\FROM included_parts\n\
\GROUP BY sub_part"
,"WITH RECURSIVE search_graph(id, link, data, depth) AS (\n\
,t "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\
@ -189,7 +191,7 @@ TODO: get all the commented out tests working
\)\n\
\SELECT * FROM search_graph;"
{-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
{-,t "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\
@ -203,7 +205,7 @@ TODO: get all the commented out tests working
\)\n\
\SELECT * FROM search_graph;"-} -- ARRAY
{-,"WITH RECURSIVE search_graph(id, link, data, depth, path, cycle) AS (\n\
{-,t "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\
@ -217,7 +219,7 @@ TODO: get all the commented out tests working
\)\n\
\SELECT * FROM search_graph;"-} -- ARRAY
,"WITH RECURSIVE t(n) AS (\n\
,t "WITH RECURSIVE t(n) AS (\n\
\ SELECT 1\n\
\ UNION ALL\n\
\ SELECT n+1 FROM t\n\
@ -226,19 +228,19 @@ TODO: get all the commented out tests working
-- select page reference
,"SELECT f.title, f.did, d.name, f.date_prod, f.kind\n\
,t "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\
,t "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;"
,t "SELECT * FROM distributors ORDER BY name;"
,t "SELECT * FROM distributors ORDER BY 2;"
,"SELECT distributors.name\n\
,t "SELECT distributors.name\n\
\ FROM distributors\n\
\ WHERE distributors.name LIKE 'W%'\n\
\UNION\n\
@ -246,14 +248,14 @@ TODO: get all the commented out tests working
\ FROM actors\n\
\ WHERE actors.name LIKE 'W%';"
,"WITH t AS (\n\
,t "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\
,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\
@ -264,16 +266,19 @@ TODO: get all the commented out tests working
\ )\n\
\SELECT distance, employee_name FROM employee_recursive;"
,"SELECT m.name AS mname, pname\n\
,t "SELECT m.name AS mname, pname\n\
\FROM manufacturers m, LATERAL get_product_names(m.id) pname;"
,"SELECT m.name AS mname, pname\n\
,t "SELECT m.name AS mname, pname\n\
\FROM manufacturers m LEFT JOIN LATERAL get_product_names(m.id) pname ON true;"
,"SELECT 2+2;"
,t "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';"
--,t "SELECT distributors.* WHERE distributors.name = 'Westward';"
]
where
t :: HasCallStack => Text -> TestItem
t src = testParseQueryExpr postgres src

174
tests/Language/SQL/SimpleSQL/QueryExprComponents.hs
View file

@ -12,7 +12,8 @@ module Language.SQL.SimpleSQL.QueryExprComponents (queryExprComponentTests) wher
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
queryExprComponentTests :: TestItem
queryExprComponentTests = Group "queryExprComponentTests"
@ -31,10 +32,10 @@ queryExprComponentTests = Group "queryExprComponentTests"
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)
duplicates = Group "duplicates"
[q "select a from t" $ ms SQDefault
,q "select all a from t" $ ms All
,q "select distinct a from t" $ ms Distinct
]
where
ms d = toQueryExpr $ makeSelect
@ -43,77 +44,77 @@ duplicates = Group "duplicates" $ map (uncurry (TestQueryExpr ansi2011))
,msFrom = [TRSimple [Name Nothing "t"]]}
selectLists :: TestItem
selectLists = Group "selectLists" $ map (uncurry (TestQueryExpr ansi2011))
[("select 1",
toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]})
selectLists = Group "selectLists"
[q "select 1"
$ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]}
,("select a"
,toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]})
,q "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)]})
,q "select a,b"
$ toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)
,(Iden [Name Nothing "b"],Nothing)]}
,("select 1+2,3+4"
,toQueryExpr $ makeSelect {msSelectList =
,q "select 1+2,3+4"
$ toQueryExpr $ makeSelect {msSelectList =
[(BinOp (NumLit "1") [Name Nothing "+"] (NumLit "2"),Nothing)
,(BinOp (NumLit "3") [Name Nothing "+"] (NumLit "4"),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")]})
,q "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")]})
,q "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 =
,q "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)]})
,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)]
whereClause = Group "whereClause"
[q "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")})
,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)
having = Group "having"
[q "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])
orderBy = Group "orderBy"
[q "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])
,q "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])
,q "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])
,q "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])
,q "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
@ -122,20 +123,20 @@ orderBy = Group "orderBy" $ map (uncurry (TestQueryExpr ansi2011))
,msOrderBy = o}
offsetFetch :: TestItem
offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))
offsetFetch = Group "offsetFetch"
[-- 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"))
q "select a from t offset 5 rows fetch next 10 rows only"
$ ms (Just $ NumLit "5") (Just $ NumLit "10")
,q "select a from t offset 5 rows;"
$ ms (Just $ NumLit "5") Nothing
,q "select a from t fetch next 10 row only;"
$ ms Nothing (Just $ NumLit "10")
,q "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"))
--,q "select a from t limit 10 offset 5"
-- $ ms (Just $ NumLit "5") (Just $ NumLit "10"))
]
where
ms o l = toQueryExpr $ makeSelect
@ -145,23 +146,23 @@ offsetFetch = Group "offsetFetch" $ map (uncurry (TestQueryExpr ansi2011))
,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)
combos = Group "combos"
[q "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)
,q "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)
,q "select a from t except all select b from u"
$ QueryExprSetOp mst Except All Respectively msu
,("select a from t union distinct corresponding \
,q "select a from t union distinct corresponding \
\select b from u"
,QueryExprSetOp mst Union Distinct Corresponding msu)
$ 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)
,q "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
@ -173,20 +174,20 @@ combos = Group "combos" $ map (uncurry (TestQueryExpr ansi2011))
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)
withQueries = Group "with queries"
[q "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)
,q "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\
,q "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 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)
,q "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
@ -197,13 +198,16 @@ withQueries = Group "with queries" $ map (uncurry (TestQueryExpr ansi2011))
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"]])
values = Group "values"
[q "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"])
tables = Group "tables"
[q "table tbl" $ Table [Name Nothing "tbl"]
]
q :: HasCallStack => Text -> QueryExpr -> TestItem
q src ast = testQueryExpr ansi2011 src ast

26
tests/Language/SQL/SimpleSQL/QueryExprs.hs
View file

@ -9,19 +9,23 @@ module Language.SQL.SimpleSQL.QueryExprs (queryExprsTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
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)]}])
queryExprsTests = Group "query exprs"
[q "select 1" [ms]
,q "select 1;" [ms]
,q "select 1;select 1" [ms,ms]
,q " select 1;select 1; " [ms,ms]
,q "SELECT CURRENT_TIMESTAMP;"
[SelectStatement $ toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "CURRENT_TIMESTAMP"],Nothing)]}]
,q "SELECT \"CURRENT_TIMESTAMP\";"
[SelectStatement $ toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name (Just ("\"","\"")) "CURRENT_TIMESTAMP"],Nothing)]}]
]
where
ms = SelectStatement $ toQueryExpr $ makeSelect {msSelectList = [(NumLit "1",Nothing)]}
q :: HasCallStack => Text -> [Statement] -> TestItem
q src ast = testStatements ansi2011 src ast

156
tests/Language/SQL/SimpleSQL/SQL2011AccessControl.hs
View file

@ -11,6 +11,8 @@ module Language.SQL.SimpleSQL.SQL2011AccessControl (sql2011AccessControlTests) w
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
sql2011AccessControlTests :: TestItem
sql2011AccessControlTests = Group "sql 2011 access control tests" [
@ -78,128 +80,107 @@ sql2011AccessControlTests = Group "sql 2011 access control tests" [
| CURRENT_ROLE
-}
(TestStatement ansi2011
"grant all privileges on tbl1 to role1"
s "grant all privileges on tbl1 to role1"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant all privileges on tbl1 to role1,role2"
,s "grant all privileges on tbl1 to role1,role2"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption)
[Name Nothing "role1",Name Nothing "role2"] WithoutGrantOption
,(TestStatement ansi2011
"grant all privileges on tbl1 to role1 with grant option"
,s "grant all privileges on tbl1 to role1 with grant option"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1"] WithGrantOption)
[Name Nothing "role1"] WithGrantOption
,(TestStatement ansi2011
"grant all privileges on table tbl1 to role1"
,s "grant all privileges on table tbl1 to role1"
$ GrantPrivilege [PrivAll]
(PrivTable [Name Nothing "tbl1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant all privileges on domain mydom to role1"
,s "grant all privileges on domain mydom to role1"
$ GrantPrivilege [PrivAll]
(PrivDomain [Name Nothing "mydom"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant all privileges on type t1 to role1"
,s "grant all privileges on type t1 to role1"
$ GrantPrivilege [PrivAll]
(PrivType [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant all privileges on sequence s1 to role1"
,s "grant all privileges on sequence s1 to role1"
$ GrantPrivilege [PrivAll]
(PrivSequence [Name Nothing "s1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant select on table t1 to role1"
,s "grant select on table t1 to role1"
$ GrantPrivilege [PrivSelect []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant select(a,b) on table t1 to role1"
,s "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)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant delete on table t1 to role1"
,s "grant delete on table t1 to role1"
$ GrantPrivilege [PrivDelete]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant insert on table t1 to role1"
,s "grant insert on table t1 to role1"
$ GrantPrivilege [PrivInsert []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant insert(a,b) on table t1 to role1"
,s "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)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant update on table t1 to role1"
,s "grant update on table t1 to role1"
$ GrantPrivilege [PrivUpdate []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant update(a,b) on table t1 to role1"
,s "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)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant references on table t1 to role1"
,s "grant references on table t1 to role1"
$ GrantPrivilege [PrivReferences []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant references(a,b) on table t1 to role1"
,s "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)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant usage on table t1 to role1"
,s "grant usage on table t1 to role1"
$ GrantPrivilege [PrivUsage]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant trigger on table t1 to role1"
,s "grant trigger on table t1 to role1"
$ GrantPrivilege [PrivTrigger]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant execute on specific function f to role1"
,s "grant execute on specific function f to role1"
$ GrantPrivilege [PrivExecute]
(PrivFunction [Name Nothing "f"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
,(TestStatement ansi2011
"grant select,delete on table t1 to role1"
,s "grant select,delete on table t1 to role1"
$ GrantPrivilege [PrivSelect [], PrivDelete]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] WithoutGrantOption)
[Name Nothing "role1"] WithoutGrantOption
{-
skipping for now:
@ -224,9 +205,8 @@ functions, etc., by argument types since they can be overloaded
CREATE ROLE <role name> [ WITH ADMIN <grantor> ]
-}
,(TestStatement ansi2011
"create role rolee"
$ CreateRole (Name Nothing "rolee"))
,s "create role rolee"
$ CreateRole (Name Nothing "rolee")
{-
@ -242,18 +222,15 @@ functions, etc., by argument types since they can be overloaded
<role name>
-}
,(TestStatement ansi2011
"grant role1 to public"
$ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption)
,s "grant role1 to public"
$ GrantRole [Name Nothing "role1"] [Name Nothing "public"] WithoutAdminOption
,(TestStatement ansi2011
"grant role1,role2 to role3,role4"
,s "grant role1,role2 to role3,role4"
$ GrantRole [Name Nothing "role1",Name Nothing "role2"]
[Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption)
[Name Nothing "role3", Name Nothing "role4"] WithoutAdminOption
,(TestStatement ansi2011
"grant role1 to role3 with admin option"
$ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption)
,s "grant role1 to role3 with admin option"
$ GrantRole [Name Nothing "role1"] [Name Nothing "role3"] WithAdminOption
{-
@ -263,9 +240,8 @@ functions, etc., by argument types since they can be overloaded
DROP ROLE <role name>
-}
,(TestStatement ansi2011
"drop role rolee"
$ DropRole (Name Nothing "rolee"))
,s "drop role rolee"
$ DropRole (Name Nothing "rolee")
{-
@ -287,17 +263,16 @@ functions, etc., by argument types since they can be overloaded
-}
,(TestStatement ansi2011
"revoke select on t1 from role1"
,s "revoke select on t1 from role1"
$ RevokePrivilege NoGrantOptionFor [PrivSelect []]
(PrivTable [Name Nothing "t1"])
[Name Nothing "role1"] DefaultDropBehaviour)
[Name Nothing "role1"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"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)
[Name Nothing "role1",Name Nothing "role2"] Cascade
{-
@ -311,20 +286,19 @@ functions, etc., by argument types since they can be overloaded
<role name>
-}
,(TestStatement ansi2011
"revoke role1 from role2"
,s "revoke role1 from role2"
$ RevokeRole NoAdminOptionFor [Name Nothing "role1"]
[Name Nothing "role2"] DefaultDropBehaviour)
[Name Nothing "role2"] DefaultDropBehaviour
,(TestStatement ansi2011
"revoke role1,role2 from role3,role4"
,s "revoke role1,role2 from role3,role4"
$ RevokeRole NoAdminOptionFor [Name Nothing "role1",Name Nothing "role2"]
[Name Nothing "role3",Name Nothing "role4"] DefaultDropBehaviour)
[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)
,s "revoke admin option for role1 from role2 cascade"
$ RevokeRole AdminOptionFor [Name Nothing "role1"] [Name Nothing "role2"] Cascade
]
s :: HasCallStack => Text -> Statement -> TestItem
s src ast = testStatement ansi2011 src ast

42
tests/Language/SQL/SimpleSQL/SQL2011Bits.hs
View file

@ -12,6 +12,8 @@ module Language.SQL.SimpleSQL.SQL2011Bits (sql2011BitsTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
sql2011BitsTests :: TestItem
sql2011BitsTests = Group "sql 2011 bits tests" [
@ -27,10 +29,8 @@ sql2011BitsTests = Group "sql 2011 bits tests" [
BEGIN is not in the standard!
-}
(TestStatement ansi2011
"start transaction"
$ StartTransaction)
s "start transaction" StartTransaction
{-
17.2 <set transaction statement>
@ -84,9 +84,8 @@ BEGIN is not in the standard!
<savepoint name>
-}
,(TestStatement ansi2011
"savepoint difficult_bit"
$ Savepoint $ Name Nothing "difficult_bit")
,s "savepoint difficult_bit"
$ Savepoint $ Name Nothing "difficult_bit"
{-
@ -96,9 +95,8 @@ BEGIN is not in the standard!
RELEASE SAVEPOINT <savepoint specifier>
-}
,(TestStatement ansi2011
"release savepoint difficult_bit"
$ ReleaseSavepoint $ Name Nothing "difficult_bit")
,s "release savepoint difficult_bit"
$ ReleaseSavepoint $ Name Nothing "difficult_bit"
{-
@ -108,13 +106,9 @@ BEGIN is not in the standard!
COMMIT [ WORK ] [ AND [ NO ] CHAIN ]
-}
,(TestStatement ansi2011
"commit"
$ Commit)
,s "commit" Commit
,(TestStatement ansi2011
"commit work"
$ Commit)
,s "commit work" Commit
{-
@ -127,17 +121,12 @@ BEGIN is not in the standard!
TO SAVEPOINT <savepoint specifier>
-}
,(TestStatement ansi2011
"rollback"
$ Rollback Nothing)
,s "rollback" $ Rollback Nothing
,(TestStatement ansi2011
"rollback work"
$ Rollback Nothing)
,s "rollback work" $ Rollback Nothing
,(TestStatement ansi2011
"rollback to savepoint difficult_bit"
$ Rollback $ Just $ Name Nothing "difficult_bit")
,s "rollback to savepoint difficult_bit"
$ Rollback $ Just $ Name Nothing "difficult_bit"
{-
@ -232,3 +221,6 @@ BEGIN is not in the standard!
-}
]
s :: HasCallStack => Text -> Statement -> TestItem
s src ast = testStatement ansi2011 src ast

77
tests/Language/SQL/SimpleSQL/SQL2011DataManipulation.hs
View file

@ -7,6 +7,8 @@ module Language.SQL.SimpleSQL.SQL2011DataManipulation (sql2011DataManipulationTe
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
sql2011DataManipulationTests :: TestItem
sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
@ -111,20 +113,20 @@ sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
[ WHERE <search condition> ]
-}
(TestStatement ansi2011 "delete from t"
$ Delete [Name Nothing "t"] Nothing Nothing)
s "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)
,s "delete from t as u"
$ Delete [Name Nothing "t"] (Just (Name Nothing "u")) Nothing
,(TestStatement ansi2011 "delete from t where x = 5"
,s "delete from t where x = 5"
$ Delete [Name Nothing "t"] Nothing
(Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5")))
(Just $ BinOp (Iden [Name Nothing "x"]) [Name Nothing "="] (NumLit "5"))
,(TestStatement ansi2011 "delete from t as u where u.x = 5"
,s "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")))
(Just $ BinOp (Iden [Name Nothing "u", Name Nothing "x"]) [Name Nothing "="] (NumLit "5"))
{-
14.10 <truncate table statement>
@ -137,14 +139,14 @@ sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
| RESTART IDENTITY
-}
,(TestStatement ansi2011 "truncate table t"
$ Truncate [Name Nothing "t"] DefaultIdentityRestart)
,s "truncate table t"
$ Truncate [Name Nothing "t"] DefaultIdentityRestart
,(TestStatement ansi2011 "truncate table t continue identity"
$ Truncate [Name Nothing "t"] ContinueIdentity)
,s "truncate table t continue identity"
$ Truncate [Name Nothing "t"] ContinueIdentity
,(TestStatement ansi2011 "truncate table t restart identity"
$ Truncate [Name Nothing "t"] RestartIdentity)
,s "truncate table t restart identity"
$ Truncate [Name Nothing "t"] RestartIdentity
{-
@ -182,37 +184,37 @@ sql2011DataManipulationTests = Group "sql 2011 data manipulation tests"
<column name list>
-}
,(TestStatement ansi2011 "insert into t select * from u"
,s "insert into t select * from u"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "u"]]})
,msFrom = [TRSimple [Name Nothing "u"]]}
,(TestStatement ansi2011 "insert into t(a,b,c) select * from u"
,s "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"]]})
,msFrom = [TRSimple [Name Nothing "u"]]}
,(TestStatement ansi2011 "insert into t default values"
$ Insert [Name Nothing "t"] Nothing DefaultInsertValues)
,s "insert into t default values"
$ Insert [Name Nothing "t"] Nothing DefaultInsertValues
,(TestStatement ansi2011 "insert into t values(1,2)"
,s "insert into t values(1,2)"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ Values [[NumLit "1", NumLit "2"]])
$ InsertQuery $ Values [[NumLit "1", NumLit "2"]]
,(TestStatement ansi2011 "insert into t values (1,2),(3,4)"
,s "insert into t values (1,2),(3,4)"
$ Insert [Name Nothing "t"] Nothing
$ InsertQuery $ Values [[NumLit "1", NumLit "2"]
,[NumLit "3", NumLit "4"]])
,[NumLit "3", NumLit "4"]]
,(TestStatement ansi2011
,s
"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 []]])
,MultisetCtor []]]
{-
@ -456,32 +458,32 @@ FROM CentralOfficeAccounts;
-}
,(TestStatement ansi2011 "update t set a=b"
,s "update t set a=b"
$ Update [Name Nothing "t"] Nothing
[Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing)
[Set [Name Nothing "a"] (Iden [Name Nothing "b"])] Nothing
,(TestStatement ansi2011 "update t set a=b, c=5"
,s "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)
,Set [Name Nothing "c"] (NumLit "5")] Nothing
,(TestStatement ansi2011 "update t set a=b where a>5"
,s "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"))
$ Just $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5")
,(TestStatement ansi2011 "update t as u set a=b where u.a>5"
,s "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"))
[Name Nothing ">"] (NumLit "5")
,(TestStatement ansi2011 "update t set (a,b)=(3,5)"
,s "update t set (a,b)=(3,5)"
$ Update [Name Nothing "t"] Nothing
[SetMultiple [[Name Nothing "a"],[Name Nothing "b"]]
[NumLit "3", NumLit "5"]] Nothing)
[NumLit "3", NumLit "5"]] Nothing
@ -553,3 +555,6 @@ declare local temporary table t (a int) [on commit {preserve | delete} rows]
]
s :: HasCallStack => Text -> Statement -> TestItem
s src ast = testStatement ansi2011 src ast

353
tests/Language/SQL/SimpleSQL/SQL2011Queries.hs
View file

@ -37,6 +37,7 @@ import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Data.Text (Text)
import Language.SQL.SimpleSQL.TestRunners
sql2011QueryTests :: TestItem
sql2011QueryTests = Group "sql 2011 query tests"
@ -515,19 +516,19 @@ generalLiterals = Group "general literals"
characterStringLiterals :: TestItem
characterStringLiterals = Group "character string literals"
$ map (uncurry (TestScalarExpr ansi2011))
[("'a regular string literal'"
,StringLit "'" "'" "a regular string literal")
,("'something' ' some more' 'and more'"
,StringLit "'" "'" "something some moreand more")
,("'something' \n ' some more' \t 'and more'"
,StringLit "'" "'" "something some moreand more")
,("'something' -- a comment\n ' some more' /*another comment*/ 'and more'"
,StringLit "'" "'" "something some moreand more")
,("'a quote: '', stuff'"
,StringLit "'" "'" "a quote: '', stuff")
,("''"
,StringLit "'" "'" "")
$
[e "'a regular string literal'"
$ StringLit "'" "'" "a regular string literal"
,e "'something' ' some more' 'and more'"
$ StringLit "'" "'" "something some moreand more"
,e "'something' \n ' some more' \t 'and more'"
$ StringLit "'" "'" "something some moreand more"
,e "'something' -- a comment\n ' some more' /*another comment*/ 'and more'"
$ StringLit "'" "'" "something some moreand more"
,e "'a quote: '', stuff'"
$ StringLit "'" "'" "a quote: '', stuff"
,e "''"
$ StringLit "'" "'" ""
{-
I'm not sure how this should work. Maybe the parser should reject non
@ -535,8 +536,8 @@ ascii characters in strings and identifiers unless the current SQL
character set allows them.
-}
,("_francais 'français'"
,TypedLit (TypeName [Name Nothing "_francais"]) "français")
,e "_francais 'français'"
$ TypedLit (TypeName [Name Nothing "_francais"]) "français"
]
{-
@ -547,9 +548,9 @@ character set allows them.
nationalCharacterStringLiterals :: TestItem
nationalCharacterStringLiterals = Group "national character string literals"
$ map (uncurry (TestScalarExpr ansi2011))
[("N'something'", StringLit "N'" "'" "something")
,("n'something'", StringLit "n'" "'" "something")
$
[e "N'something'" $ StringLit "N'" "'" "something"
,e "n'something'" $ StringLit "n'" "'" "something"
]
{-
@ -566,8 +567,8 @@ nationalCharacterStringLiterals = Group "national character string literals"
unicodeCharacterStringLiterals :: TestItem
unicodeCharacterStringLiterals = Group "unicode character string literals"
$ map (uncurry (TestScalarExpr ansi2011))
[("U&'something'", StringLit "U&'" "'" "something")
$
[e "U&'something'" $ StringLit "U&'" "'" "something"
{-,("u&'something' escape ="
,Escape (StringLit "u&'" "'" "something") '=')
,("u&'something' uescape ="
@ -587,9 +588,9 @@ TODO: unicode escape
binaryStringLiterals :: TestItem
binaryStringLiterals = Group "binary string literals"
$ map (uncurry (TestScalarExpr ansi2011))
$
[--("B'101010'", CSStringLit "B" "101010")
("X'7f7f7f'", StringLit "X'" "'" "7f7f7f")
e "X'7f7f7f'" $ StringLit "X'" "'" "7f7f7f"
--,("X'7f7f7f' escape z", Escape (StringLit "X'" "'" "7f7f7f") 'z')
]
@ -619,33 +620,32 @@ binaryStringLiterals = Group "binary string literals"
numericLiterals :: TestItem
numericLiterals = Group "numeric literals"
$ map (uncurry (TestScalarExpr ansi2011))
[("11", NumLit "11")
,("11.11", NumLit "11.11")
[e "11" $ NumLit "11"
,e "11.11" $ NumLit "11.11"
,("11E23", NumLit "11E23")
,("11E+23", NumLit "11E+23")
,("11E-23", NumLit "11E-23")
,e "11E23" $ NumLit "11E23"
,e "11E+23" $ NumLit "11E+23"
,e "11E-23" $ NumLit "11E-23"
,("11.11E23", NumLit "11.11E23")
,("11.11E+23", NumLit "11.11E+23")
,("11.11E-23", NumLit "11.11E-23")
,e "11.11E23" $ NumLit "11.11E23"
,e "11.11E+23" $ NumLit "11.11E+23"
,e "11.11E-23" $ NumLit "11.11E-23"
,("+11E23", PrefixOp [Name Nothing "+"] $ NumLit "11E23")
,("+11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11E+23")
,("+11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11E-23")
,("+11.11E23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E23")
,("+11.11E+23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23")
,("+11.11E-23", PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23")
,e "+11E23" $ PrefixOp [Name Nothing "+"] $ NumLit "11E23"
,e "+11E+23" $ PrefixOp [Name Nothing "+"] $ NumLit "11E+23"
,e "+11E-23" $ PrefixOp [Name Nothing "+"] $ NumLit "11E-23"
,e "+11.11E23" $ PrefixOp [Name Nothing "+"] $ NumLit "11.11E23"
,e "+11.11E+23" $ PrefixOp [Name Nothing "+"] $ NumLit "11.11E+23"
,e "+11.11E-23" $ PrefixOp [Name Nothing "+"] $ NumLit "11.11E-23"
,("-11E23", PrefixOp [Name Nothing "-"] $ NumLit "11E23")
,("-11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11E+23")
,("-11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11E-23")
,("-11.11E23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E23")
,("-11.11E+23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23")
,("-11.11E-23", PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23")
,e "-11E23" $ PrefixOp [Name Nothing "-"] $ NumLit "11E23"
,e "-11E+23" $ PrefixOp [Name Nothing "-"] $ NumLit "11E+23"
,e "-11E-23" $ PrefixOp [Name Nothing "-"] $ NumLit "11E-23"
,e "-11.11E23" $ PrefixOp [Name Nothing "-"] $ NumLit "11.11E23"
,e "-11.11E+23" $ PrefixOp [Name Nothing "-"] $ NumLit "11.11E+23"
,e "-11.11E-23" $ PrefixOp [Name Nothing "-"] $ NumLit "11.11E-23"
,("11.11e23", NumLit "11.11e23")
,e "11.11e23" $ NumLit "11.11e23"
]
@ -729,33 +729,30 @@ dateTimeLiterals = Group "datetime literals"
intervalLiterals :: TestItem
intervalLiterals = Group "intervalLiterals literals"
$ map (uncurry (TestScalarExpr ansi2011))
[("interval '1'", TypedLit (TypeName [Name Nothing "interval"]) "1")
,("interval '1' day"
,IntervalLit Nothing "1" (Itf "day" Nothing) Nothing)
,("interval '1' day(3)"
,IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing)
,("interval + '1' day(3)"
,IntervalLit (Just Plus) "1" (Itf "day" $ Just (3,Nothing)) Nothing)
,("interval - '1' second(2,2)"
,IntervalLit (Just Minus) "1" (Itf "second" $ Just (2,Just 2)) Nothing)
,("interval '1' year to month"
,IntervalLit Nothing "1" (Itf "year" Nothing)
(Just $ Itf "month" Nothing))
,("interval '1' year(4) to second(2,3) "
,IntervalLit Nothing "1" (Itf "year" $ Just (4,Nothing))
(Just $ Itf "second" $ Just (2, Just 3)))
[e "interval '1'" $ TypedLit (TypeName [Name Nothing "interval"]) "1"
,e "interval '1' day"
$ IntervalLit Nothing "1" (Itf "day" Nothing) Nothing
,e "interval '1' day(3)"
$ IntervalLit Nothing "1" (Itf "day" $ Just (3,Nothing)) Nothing
,e "interval + '1' day(3)"
$ IntervalLit (Just Plus) "1" (Itf "day" $ Just (3,Nothing)) Nothing
,e "interval - '1' second(2,2)"
$ IntervalLit (Just Minus) "1" (Itf "second" $ Just (2,Just 2)) Nothing
,e "interval '1' year to month"
$ IntervalLit Nothing "1" (Itf "year" Nothing)
(Just $ Itf "month" Nothing)
,e "interval '1' year(4) to second(2,3) "
$ IntervalLit Nothing "1" (Itf "year" $ Just (4,Nothing))
(Just $ Itf "second" $ Just (2, Just 3))
]
-- <boolean literal> ::= TRUE | FALSE | UNKNOWN
booleanLiterals :: TestItem
booleanLiterals = Group "boolean literals"
$ map (uncurry (TestScalarExpr ansi2011))
[("true", Iden [Name Nothing "true"])
,("false", Iden [Name Nothing "false"])
,("unknown", Iden [Name Nothing "unknown"])
[e "true" $ Iden [Name Nothing "true"]
,e "false" $ Iden [Name Nothing "false"]
,e "unknown" $ Iden [Name Nothing "unknown"]
]
{-
@ -774,16 +771,15 @@ Specify names.
identifiers :: TestItem
identifiers = Group "identifiers"
$ map (uncurry (TestScalarExpr ansi2011))
[("test",Iden [Name Nothing "test"])
,("_test",Iden [Name Nothing "_test"])
,("t1",Iden [Name Nothing "t1"])
,("a.b",Iden [Name Nothing "a", Name Nothing "b"])
,("a.b.c",Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"])
,("\"quoted iden\"", Iden [Name (Just ("\"","\"")) "quoted iden"])
,("\"quoted \"\" iden\"", Iden [Name (Just ("\"","\"")) "quoted \"\" iden"])
,("U&\"quoted iden\"", Iden [Name (Just ("U&\"","\"")) "quoted iden"])
,("U&\"quoted \"\" iden\"", Iden [Name (Just ("U&\"","\"")) "quoted \"\" iden"])
[e "test" $ Iden [Name Nothing "test"]
,e "_test" $ Iden [Name Nothing "_test"]
,e "t1" $ Iden [Name Nothing "t1"]
,e "a.b" $ Iden [Name Nothing "a", Name Nothing "b"]
,e "a.b.c" $ Iden [Name Nothing "a", Name Nothing "b", Name Nothing "c"]
,e "\"quoted iden\"" $ Iden [Name (Just ("\"", "\"")) "quoted iden"]
,e "\"quoted \"\" iden\"" $ Iden [Name (Just ("\"", "\"")) "quoted \"\" iden"]
,e "U&\"quoted iden\"" $ Iden [Name (Just ("U&\"", "\"")) "quoted iden"]
,e "U&\"quoted \"\" iden\"" $ Iden [Name (Just ("U&\"", "\"")) "quoted \"\" iden"]
]
{-
@ -1220,11 +1216,11 @@ expression
typeNameTests :: TestItem
typeNameTests = Group "type names"
[Group "type names" $ map (uncurry (TestScalarExpr ansi2011))
[Group "type names" $ map (uncurry (testScalarExpr ansi2011))
$ concatMap makeSimpleTests $ fst typeNames
,Group "generated casts" $ map (uncurry (TestScalarExpr ansi2011))
,Group "generated casts" $ map (uncurry (testScalarExpr ansi2011))
$ concatMap makeCastTests $ fst typeNames
,Group "generated typename" $ map (uncurry (TestScalarExpr ansi2011))
,Group "generated typename" $ map (uncurry (testScalarExpr ansi2011))
$ concatMap makeTests $ snd typeNames]
where
makeSimpleTests (ctn, stn) =
@ -1247,12 +1243,10 @@ Define a field of a row type.
fieldDefinition :: TestItem
fieldDefinition = Group "field definition"
$ map (uncurry (TestScalarExpr ansi2011))
[("cast('(1,2)' as row(a int,b char))"
,Cast (StringLit "'" "'" "(1,2)")
[e "cast('(1,2)' as row(a int,b char))"
$ Cast (StringLit "'" "'" "(1,2)")
$ RowTypeName [(Name Nothing "a", TypeName [Name Nothing "int"])
,(Name Nothing "b", TypeName [Name Nothing "char"])])]
,(Name Nothing "b", TypeName [Name Nothing "char"])]]
{-
== 6.3 <value expression primary>
@ -1329,9 +1323,8 @@ valueExpressions = Group "value expressions"
parenthesizedScalarExpression :: TestItem
parenthesizedScalarExpression = Group "parenthesized value expression"
$ map (uncurry (TestScalarExpr ansi2011))
[("(3)", Parens (NumLit "3"))
,("((3))", Parens $ Parens (NumLit "3"))
[e "(3)" $ Parens (NumLit "3")
,e "((3))" $ Parens $ Parens (NumLit "3")
]
{-
@ -1367,8 +1360,7 @@ Specify one or more values, host parameters, SQL parameters, dynamic parameters,
generalValueSpecification :: TestItem
generalValueSpecification = Group "general value specification"
$ map (uncurry (TestScalarExpr ansi2011)) $
map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"
$ map mkIden ["CURRENT_DEFAULT_TRANSFORM_GROUP"
,"CURRENT_PATH"
,"CURRENT_ROLE"
,"CURRENT_USER"
@ -1377,7 +1369,7 @@ generalValueSpecification = Group "general value specification"
,"USER"
,"VALUE"]
where
mkIden nm = (nm,Iden [Name Nothing nm])
mkIden nm = e nm $ Iden [Name Nothing nm]
{-
TODO: add the missing bits
@ -1423,12 +1415,11 @@ TODO: add the missing bits
parameterSpecification :: TestItem
parameterSpecification = Group "parameter specification"
$ map (uncurry (TestScalarExpr ansi2011))
[(":hostparam", HostParameter ":hostparam" Nothing)
,(":hostparam indicator :another_host_param"
,HostParameter ":hostparam" $ Just ":another_host_param")
,("?", Parameter)
,(":h[3]", Array (HostParameter ":h" Nothing) [NumLit "3"])
[e ":hostparam" $ HostParameter ":hostparam" Nothing
,e ":hostparam indicator :another_host_param"
$ HostParameter ":hostparam" $ Just ":another_host_param"
,e "?" $ Parameter
,e ":h[3]" $ Array (HostParameter ":h" Nothing) [NumLit "3"]
]
{-
@ -1462,11 +1453,10 @@ Specify a value whose data type is to be inferred from its context.
contextuallyTypedValueSpecification :: TestItem
contextuallyTypedValueSpecification =
Group "contextually typed value specification"
$ map (uncurry (TestScalarExpr ansi2011))
[("null", Iden [Name Nothing "null"])
,("array[]", Array (Iden [Name Nothing "array"]) [])
,("multiset[]", MultisetCtor [])
,("default", Iden [Name Nothing "default"])
[e "null" $ Iden [Name Nothing "null"]
,e "array[]" $ Array (Iden [Name Nothing "array"]) []
,e "multiset[]" $ MultisetCtor []
,e "default" $ Iden [Name Nothing "default"]
]
{-
@ -1482,8 +1472,7 @@ Disambiguate a <period>-separated chain of identifiers.
identifierChain :: TestItem
identifierChain = Group "identifier chain"
$ map (uncurry (TestScalarExpr ansi2011))
[("a.b", Iden [Name Nothing "a",Name Nothing "b"])]
[e "a.b" $ Iden [Name Nothing "a",Name Nothing "b"]]
{-
== 6.7 <column reference>
@ -1498,8 +1487,7 @@ Reference a column.
columnReference :: TestItem
columnReference = Group "column reference"
$ map (uncurry (TestScalarExpr ansi2011))
[("module.a.b", Iden [Name Nothing "module",Name Nothing "a",Name Nothing "b"])]
[e "module.a.b" $ Iden [Name Nothing "module",Name Nothing "a",Name Nothing "b"]]
{-
== 6.8 <SQL parameter reference>
@ -1523,19 +1511,19 @@ Specify a value derived by the application of a function to an argument.
setFunctionSpecification :: TestItem
setFunctionSpecification = Group "set function specification"
$ map (uncurry (TestQueryExpr ansi2011))
[("SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\
$
[q "SELECT SalesQuota, SUM(SalesYTD) TotalSalesYTD,\n\
\ GROUPING(SalesQuota) AS Grouping\n\
\FROM Sales.SalesPerson\n\
\GROUP BY ROLLUP(SalesQuota);"
,toQueryExpr $ makeSelect
$ toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "SalesQuota"],Nothing)
,(App [Name Nothing "SUM"] [Iden [Name Nothing "SalesYTD"]]
,Just (Name Nothing "TotalSalesYTD"))
,(App [Name Nothing "GROUPING"] [Iden [Name Nothing "SalesQuota"]]
,Just (Name Nothing "Grouping"))]
,msFrom = [TRSimple [Name Nothing "Sales",Name Nothing "SalesPerson"]]
,msGroupBy = [Rollup [SimpleGroup (Iden [Name Nothing "SalesQuota"])]]})
,msGroupBy = [Rollup [SimpleGroup (Iden [Name Nothing "SalesQuota"])]]}
]
{-
@ -1732,9 +1720,8 @@ Specify a data conversion.
castSpecification :: TestItem
castSpecification = Group "cast specification"
$ map (uncurry (TestScalarExpr ansi2011))
[("cast(a as int)"
,Cast (Iden [Name Nothing "a"]) (TypeName [Name Nothing "int"]))
[e "cast(a as int)"
$ Cast (Iden [Name Nothing "a"]) (TypeName [Name Nothing "int"])
]
{-
@ -1748,8 +1735,7 @@ Return the next value of a sequence generator.
nextScalarExpression :: TestItem
nextScalarExpression = Group "next value expression"
$ map (uncurry (TestScalarExpr ansi2011))
[("next value for a.b", NextValueFor [Name Nothing "a", Name Nothing "b"])
[e "next value for a.b" $ NextValueFor [Name Nothing "a", Name Nothing "b"]
]
{-
@ -1763,11 +1749,10 @@ Reference a field of a row value.
fieldReference :: TestItem
fieldReference = Group "field reference"
$ map (uncurry (TestScalarExpr ansi2011))
[("f(something).a"
,BinOp (App [Name Nothing "f"] [Iden [Name Nothing "something"]])
[e "f(something).a"
$ BinOp (App [Name Nothing "f"] [Iden [Name Nothing "something"]])
[Name Nothing "."]
(Iden [Name Nothing "a"]))
(Iden [Name Nothing "a"])
]
{-
@ -1889,17 +1874,16 @@ Return an element of an array.
arrayElementReference :: TestItem
arrayElementReference = Group "array element reference"
$ map (uncurry (TestScalarExpr ansi2011))
[("something[3]"
,Array (Iden [Name Nothing "something"]) [NumLit "3"])
,("(something(a))[x]"
,Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))
[Iden [Name Nothing "x"]])
,("(something(a))[x][y] "
,Array (
[e "something[3]"
$ Array (Iden [Name Nothing "something"]) [NumLit "3"]
,e "(something(a))[x]"
$ Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))
[Iden [Name Nothing "x"]]
,e "(something(a))[x][y] "
$ Array (
Array (Parens (App [Name Nothing "something"] [Iden [Name Nothing "a"]]))
[Iden [Name Nothing "x"]])
[Iden [Name Nothing "y"]])
[Iden [Name Nothing "y"]]
]
{-
@ -1914,9 +1898,8 @@ Return the sole element of a multiset of one element.
multisetElementReference :: TestItem
multisetElementReference = Group "multisetElementReference"
$ map (uncurry (TestScalarExpr ansi2011))
[("element(something)"
,App [Name Nothing "element"] [Iden [Name Nothing "something"]])
[e "element(something)"
$ App [Name Nothing "element"] [Iden [Name Nothing "something"]]
]
{-
@ -1966,13 +1949,12 @@ Specify a numeric value.
numericScalarExpression :: TestItem
numericScalarExpression = Group "numeric value expression"
$ map (uncurry (TestScalarExpr ansi2011))
[("a + b", binOp "+")
,("a - b", binOp "-")
,("a * b", binOp "*")
,("a / b", binOp "/")
,("+a", prefOp "+")
,("-a", prefOp "-")
[e "a + b" $ binOp "+"
,e "a - b" $ binOp "-"
,e "a * b" $ binOp "*"
,e "a / b" $ binOp "/"
,e "+a" $ prefOp "+"
,e "-a" $ prefOp "-"
]
where
binOp o = BinOp (Iden [Name Nothing "a"]) [Name Nothing o] (Iden [Name Nothing "b"])
@ -2439,17 +2421,16 @@ Specify a boolean value.
booleanScalarExpression :: TestItem
booleanScalarExpression = Group "booleab value expression"
$ map (uncurry (TestScalarExpr ansi2011))
[("a or b", BinOp a [Name Nothing "or"] b)
,("a and b", BinOp a [Name Nothing "and"] b)
,("not a", PrefixOp [Name Nothing "not"] a)
,("a is true", postfixOp "is true")
,("a is false", postfixOp "is false")
,("a is unknown", postfixOp "is unknown")
,("a is not true", postfixOp "is not true")
,("a is not false", postfixOp "is not false")
,("a is not unknown", postfixOp "is not unknown")
,("(a or b)", Parens $ BinOp a [Name Nothing "or"] b)
[e "a or b" $ BinOp a [Name Nothing "or"] b
,e "a and b" $ BinOp a [Name Nothing "and"] b
,e "not a" $ PrefixOp [Name Nothing "not"] a
,e "a is true" $ postfixOp "is true"
,e "a is false" $ postfixOp "is false"
,e "a is unknown" $ postfixOp "is unknown"
,e "a is not true" $ postfixOp "is not true"
,e "a is not false" $ postfixOp "is not false"
,e "a is not unknown" $ postfixOp "is not unknown"
,e "(a or b)" $ Parens $ BinOp a [Name Nothing "or"] b
]
where
a = Iden [Name Nothing "a"]
@ -2520,23 +2501,22 @@ Specify construction of an array.
arrayValueConstructor :: TestItem
arrayValueConstructor = Group "array value constructor"
$ map (uncurry (TestScalarExpr ansi2011))
[("array[1,2,3]"
,Array (Iden [Name Nothing "array"])
[NumLit "1", NumLit "2", NumLit "3"])
,("array[a,b,c]"
,Array (Iden [Name Nothing "array"])
[Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]])
,("array(select * from t)"
,ArrayCtor (toQueryExpr $ makeSelect
[e "array[1,2,3]"
$ Array (Iden [Name Nothing "array"])
[NumLit "1", NumLit "2", NumLit "3"]
,e "array[a,b,c]"
$ Array (Iden [Name Nothing "array"])
[Iden [Name Nothing "a"], Iden [Name Nothing "b"], Iden [Name Nothing "c"]]
,e "array(select * from t)"
$ ArrayCtor (toQueryExpr $ makeSelect
{msSelectList = [(Star,Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]}))
,("array(select * from t order by a)"
,ArrayCtor (toQueryExpr $ makeSelect
,msFrom = [TRSimple [Name Nothing "t"]]})
,e "array(select * from t order by a)"
$ ArrayCtor (toQueryExpr $ makeSelect
{msSelectList = [(Star,Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
,msOrderBy = [SortSpec (Iden [Name Nothing "a"])
DirDefault NullsOrderDefault]}))
DirDefault NullsOrderDefault]})
]
@ -2560,7 +2540,7 @@ Specify a multiset value.
multisetScalarExpression :: TestItem
multisetScalarExpression = Group "multiset value expression"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("a multiset union b"
,MultisetBinOp (Iden [Name Nothing "a"]) Union SQDefault (Iden [Name Nothing "b"]))
,("a multiset union all b"
@ -2592,7 +2572,7 @@ special case term.
multisetValueFunction :: TestItem
multisetValueFunction = Group "multiset value function"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("set(a)", App [Name Nothing "set"] [Iden [Name Nothing "a"]])
]
@ -2622,7 +2602,7 @@ Specify construction of a multiset.
multisetValueConstructor :: TestItem
multisetValueConstructor = Group "multiset value constructor"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("multiset[a,b,c]", MultisetCtor[Iden [Name Nothing "a"]
,Iden [Name Nothing "b"], Iden [Name Nothing "c"]])
,("multiset(select * from t)", MultisetQueryCtor ms)
@ -2702,7 +2682,7 @@ Specify a value or list of values to be constructed into a row.
rowValueConstructor :: TestItem
rowValueConstructor = Group "row value constructor"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("(a,b)"
,SpecialOp [Name Nothing "rowctor"] [Iden [Name Nothing "a"], Iden [Name Nothing "b"]])
,("row(1)",App [Name Nothing "row"] [NumLit "1"])
@ -2755,7 +2735,7 @@ Specify a set of <row value expression>s to be constructed into a table.
tableValueConstructor :: TestItem
tableValueConstructor = Group "table value constructor"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("values (1,2), (a+b,(select count(*) from t));"
,Values [[NumLit "1", NumLit "2"]
,[BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"]
@ -2792,7 +2772,7 @@ Specify a table derived from one or more tables.
fromClause :: TestItem
fromClause = Group "fromClause"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select * from tbl1,tbl2"
,toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
@ -2809,7 +2789,7 @@ Reference a table.
tableReference :: TestItem
tableReference = Group "table reference"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select * from t", toQueryExpr sel)
{-
@ -2994,7 +2974,7 @@ Specify a table derived from a Cartesian product, inner join, or outer join.
joinedTable :: TestItem
joinedTable = Group "joined table"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select * from a cross join b"
,sel $ TRJoin a False JCross b Nothing)
,("select * from a join b on true"
@ -3053,7 +3033,7 @@ the result of the preceding <from clause>.
whereClause :: TestItem
whereClause = Group "where clause"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select * from t where a = 5"
,toQueryExpr $ makeSelect
{msSelectList = [(Star,Nothing)]
@ -3115,7 +3095,7 @@ clause> to the result of the previously specified clause.
groupByClause :: TestItem
groupByClause = Group "group by clause"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select a,sum(x) from t group by a"
,toQueryExpr $ ms [SimpleGroup $ Iden [Name Nothing "a"]])
,("select a,sum(x) from t group by a collate c"
@ -3170,7 +3150,7 @@ not satisfy a <search condition>.
havingClause :: TestItem
havingClause = Group "having clause"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select a,sum(x) from t group by a having sum(x) > 1000"
,toQueryExpr $ makeSelect
{msSelectList = [(Iden [Name Nothing "a"], Nothing)
@ -3297,7 +3277,7 @@ Specify a table derived from the result of a <table expression>.
querySpecification :: TestItem
querySpecification = Group "query specification"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select a from t",toQueryExpr ms)
,("select all a from t",toQueryExpr $ ms {msSetQuantifier = All})
,("select distinct a from t",toQueryExpr $ ms {msSetQuantifier = Distinct})
@ -3369,7 +3349,7 @@ withQueryExpression= Group "with query expression"
setOpQueryExpression :: TestItem
setOpQueryExpression= Group "set operation query expression"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
-- todo: complete setop query expression tests
[{-("select * from t union select * from t"
,undefined)
@ -3408,7 +3388,7 @@ everywhere
explicitTableQueryExpression :: TestItem
explicitTableQueryExpression= Group "explicit table query expression"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("table t", Table [Name Nothing "t"])
]
@ -3432,7 +3412,7 @@ explicitTableQueryExpression= Group "explicit table query expression"
orderOffsetFetchQueryExpression :: TestItem
orderOffsetFetchQueryExpression = Group "order, offset, fetch query expression"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[-- todo: finish tests for order offset and fetch
("select a from t order by a"
,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])
@ -3597,7 +3577,7 @@ Specify a comparison of two row values.
comparisonPredicates :: TestItem
comparisonPredicates = Group "comparison predicates"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
$ map mkOp ["=", "<>", "<", ">", "<=", ">="]
<> [("ROW(a) = ROW(b)"
,BinOp (App [Name Nothing "ROW"] [a])
@ -3815,7 +3795,7 @@ Specify a quantified comparison.
quantifiedComparisonPredicate :: TestItem
quantifiedComparisonPredicate = Group "quantified comparison predicate"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("a = any (select * from t)"
,QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "="] CPAny ms)
@ -3844,7 +3824,7 @@ Specify a test for a non-empty set.
existsPredicate :: TestItem
existsPredicate = Group "exists predicate"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("exists(select * from t where a = 4)"
,SubQueryExpr SqExists
$ toQueryExpr $ makeSelect
@ -3865,7 +3845,7 @@ Specify a test for the absence of duplicate rows.
uniquePredicate :: TestItem
uniquePredicate = Group "unique predicate"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("unique(select * from t where a = 4)"
,SubQueryExpr SqUnique
$ toQueryExpr $ makeSelect
@ -3905,7 +3885,7 @@ Specify a test for matching rows.
matchPredicate :: TestItem
matchPredicate = Group "match predicate"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("a match (select a from t)"
,Match (Iden [Name Nothing "a"]) False $ toQueryExpr ms)
,("(a,b) match (select a,b from t)"
@ -4273,7 +4253,7 @@ Specify a default collation.
collateClause :: TestItem
collateClause = Group "collate clause"
$ map (uncurry (TestScalarExpr ansi2011))
$ map (uncurry (testScalarExpr ansi2011))
[("a collate my_collation"
,Collate (Iden [Name Nothing "a"]) [Name Nothing "my_collation"])]
@ -4386,7 +4366,7 @@ Specify a value computed from a collection of rows.
aggregateFunction :: TestItem
aggregateFunction = Group "aggregate function"
$ map (uncurry (TestScalarExpr ansi2011)) $
$ map (uncurry (testScalarExpr ansi2011)) $
[("count(*)",App [Name Nothing "count"] [Star])
,("count(*) filter (where something > 5)"
,AggregateApp [Name Nothing "count"] SQDefault [Star] [] fil)
@ -4483,7 +4463,7 @@ Specify a sort order.
sortSpecificationList :: TestItem
sortSpecificationList = Group "sort specification list"
$ map (uncurry (TestQueryExpr ansi2011))
$ map (uncurry (testQueryExpr ansi2011))
[("select * from t order by a"
,toQueryExpr $ ms {msOrderBy = [SortSpec (Iden [Name Nothing "a"])
DirDefault NullsOrderDefault]})
@ -4518,3 +4498,10 @@ sortSpecificationList = Group "sort specification list"
ms = makeSelect
{msSelectList = [(Star,Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]}
q :: HasCallStack => Text -> QueryExpr -> TestItem
q src ast = testQueryExpr ansi2011 src ast
e :: HasCallStack => Text -> ScalarExpr -> TestItem
e src ast = testScalarExpr ansi2011 src ast

340
tests/Language/SQL/SimpleSQL/SQL2011Schema.hs
View file

@ -10,6 +10,8 @@ module Language.SQL.SimpleSQL.SQL2011Schema (sql2011SchemaTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
sql2011SchemaTests :: TestItem
sql2011SchemaTests = Group "sql 2011 schema tests"
@ -25,8 +27,8 @@ sql2011SchemaTests = Group "sql 2011 schema tests"
[ <schema element>... ]
-}
(TestStatement ansi2011 "create schema my_schema"
$ CreateSchema [Name Nothing "my_schema"])
s "create schema my_schema"
$ CreateSchema [Name Nothing "my_schema"]
{-
todo: schema name can have .
@ -86,12 +88,12 @@ add schema element support:
-}
,(TestStatement ansi2011 "drop schema my_schema"
$ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour)
,(TestStatement ansi2011 "drop schema my_schema cascade"
$ DropSchema [Name Nothing "my_schema"] Cascade)
,(TestStatement ansi2011 "drop schema my_schema restrict"
$ DropSchema [Name Nothing "my_schema"] Restrict)
,s "drop schema my_schema"
$ DropSchema [Name Nothing "my_schema"] DefaultDropBehaviour
,s "drop schema my_schema cascade"
$ DropSchema [Name Nothing "my_schema"] Cascade
,s "drop schema my_schema restrict"
$ DropSchema [Name Nothing "my_schema"] Restrict
{-
11.3 <table definition>
@ -103,10 +105,10 @@ add schema element support:
[ ON COMMIT <table commit action> ROWS ]
-}
,(TestStatement ansi2011 "create table t (a int, b int);"
,s "create table t (a int, b int);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []])
,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []]
{-
@ -321,35 +323,35 @@ todo: constraint characteristics
-}
,(TestStatement ansi2011
,s
"create table t (a int not null);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing ColNotNullConstraint]])
[ColConstraintDef Nothing ColNotNullConstraint]]
,(TestStatement ansi2011
,s
"create table t (a int constraint a_not_null not null);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]])
[ColConstraintDef (Just [Name Nothing "a_not_null"]) ColNotNullConstraint]]
,(TestStatement ansi2011
,s
"create table t (a int unique);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing ColUniqueConstraint]])
[ColConstraintDef Nothing ColUniqueConstraint]]
,(TestStatement ansi2011
,s
"create table t (a int primary key);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing (ColPrimaryKeyConstraint False)]])
[ColConstraintDef Nothing (ColPrimaryKeyConstraint False)]]
,(TestStatement ansi2011 { diAutoincrement = True }
,testStatement ansi2011{ diAutoincrement = True }
"create table t (a int primary key autoincrement);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing (ColPrimaryKeyConstraint True)]])
[ColConstraintDef Nothing (ColPrimaryKeyConstraint True)]]
{-
references t(a,b)
@ -358,102 +360,102 @@ references t(a,b)
on delete ""
-}
,(TestStatement ansi2011
,s
"create table t (a int references u);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
DefaultReferentialAction DefaultReferentialAction]])
DefaultReferentialAction DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u(a));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] (Just $ Name Nothing "a") DefaultReferenceMatch
DefaultReferentialAction DefaultReferentialAction]])
DefaultReferentialAction DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u match full);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing MatchFull
DefaultReferentialAction DefaultReferentialAction]])
DefaultReferentialAction DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u match partial);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing MatchPartial
DefaultReferentialAction DefaultReferentialAction]])
DefaultReferentialAction DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u match simple);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing MatchSimple
DefaultReferentialAction DefaultReferentialAction]])
DefaultReferentialAction DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u on update cascade );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
RefCascade DefaultReferentialAction]])
RefCascade DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u on update set null );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
RefSetNull DefaultReferentialAction]])
RefSetNull DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u on update set default );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
RefSetDefault DefaultReferentialAction]])
RefSetDefault DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u on update no action );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
RefNoAction DefaultReferentialAction]])
RefNoAction DefaultReferentialAction]]
,(TestStatement ansi2011
,s
"create table t (a int references u on delete cascade );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
DefaultReferentialAction RefCascade]])
DefaultReferentialAction RefCascade]]
,(TestStatement ansi2011
,s
"create table t (a int references u on update cascade on delete restrict );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
RefCascade RefRestrict]])
RefCascade RefRestrict]]
,(TestStatement ansi2011
,s
"create table t (a int references u on delete restrict on update cascade );"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing $ ColReferencesConstraint
[Name Nothing "u"] Nothing DefaultReferenceMatch
RefCascade RefRestrict]])
RefCascade RefRestrict]]
{-
TODO: try combinations and permutations of column constraints and
@ -461,12 +463,12 @@ options
-}
,(TestStatement ansi2011
,s
"create table t (a int check (a>5));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing
[ColConstraintDef Nothing
(ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]])
(ColCheckConstraint $ BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (NumLit "5"))]]
@ -478,18 +480,18 @@ options
[ <left paren> <common sequence generator options> <right paren> ]
-}
,(TestStatement ansi2011 "create table t (a int generated always as identity);"
,s "create table t (a int generated always as identity);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])
(Just $ IdentityColumnSpec GeneratedAlways []) []])
(Just $ IdentityColumnSpec GeneratedAlways []) []]
,(TestStatement ansi2011 "create table t (a int generated by default as identity);"
,s "create table t (a int generated by default as identity);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])
(Just $ IdentityColumnSpec GeneratedByDefault []) []])
(Just $ IdentityColumnSpec GeneratedByDefault []) []]
,(TestStatement ansi2011
,s
"create table t (a int generated always as identity\n\
\ ( start with 5 increment by 5 maxvalue 500 minvalue 5 cycle ));"
$ CreateTable [Name Nothing "t"]
@ -499,9 +501,9 @@ options
,SGOIncrementBy 5
,SGOMaxValue 500
,SGOMinValue 5
,SGOCycle]) []])
,SGOCycle]) []]
,(TestStatement ansi2011
,s
"create table t (a int generated always as identity\n\
\ ( start with -4 no maxvalue no minvalue no cycle ));"
$ CreateTable [Name Nothing "t"]
@ -510,7 +512,7 @@ options
[SGOStartWith (-4)
,SGONoMaxValue
,SGONoMinValue
,SGONoCycle]) []])
,SGONoCycle]) []]
{-
I think <common sequence generator options> is supposed to just
@ -531,14 +533,14 @@ generated always (valueexpr)
<left paren> <value expression> <right paren>
-}
,(TestStatement ansi2011
,s
"create table t (a int, \n\
\ a2 int generated always as (a * 2));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
,TableColumnDef $ ColumnDef (Name Nothing "a2") (TypeName [Name Nothing "int"])
(Just $ GenerationClause
(BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []])
(BinOp (Iden [Name Nothing "a"]) [Name Nothing "*"] (NumLit "2"))) []]
@ -563,10 +565,10 @@ generated always (valueexpr)
-}
,(TestStatement ansi2011 "create table t (a int default 0);"
,s "create table t (a int default 0);"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"])
(Just $ DefaultClause $ NumLit "0") []])
(Just $ DefaultClause $ NumLit "0") []]
@ -597,40 +599,40 @@ generated always (valueexpr)
<column name list>
-}
,(TestStatement ansi2011
,s
"create table t (a int, unique (a));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
,TableConstraintDef Nothing $ TableUniqueConstraint [Name Nothing "a"]
])
]
,(TestStatement ansi2011
,s
"create table t (a int, constraint a_unique unique (a));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
,TableConstraintDef (Just [Name Nothing "a_unique"]) $
TableUniqueConstraint [Name Nothing "a"]
])
]
-- todo: test permutations of column defs and table constraints
,(TestStatement ansi2011
,s
"create table t (a int, b int, unique (a,b));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []
,TableConstraintDef Nothing $
TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]
])
]
,(TestStatement ansi2011
,s
"create table t (a int, b int, primary key (a,b));"
$ CreateTable [Name Nothing "t"]
[TableColumnDef $ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
,TableColumnDef $ ColumnDef (Name Nothing "b") (TypeName [Name Nothing "int"]) Nothing []
,TableConstraintDef Nothing $
TablePrimaryKeyConstraint [Name Nothing "a", Name Nothing "b"]
])
]
{-
@ -649,7 +651,7 @@ defintely skip
-}
,(TestStatement ansi2011
,s
"create table t (a int, b int,\n\
\ foreign key (a,b) references u(c,d) match full on update cascade on delete restrict );"
$ CreateTable [Name Nothing "t"]
@ -661,9 +663,9 @@ defintely skip
[Name Nothing "u"]
(Just [Name Nothing "c", Name Nothing "d"])
MatchFull RefCascade RefRestrict
])
]
,(TestStatement ansi2011
,s
"create table t (a int,\n\
\ constraint tfku1 foreign key (a) references u);"
$ CreateTable [Name Nothing "t"]
@ -674,9 +676,9 @@ defintely skip
[Name Nothing "u"]
Nothing DefaultReferenceMatch
DefaultReferentialAction DefaultReferentialAction
])
]
,(TestStatement ansi2011 { diNonCommaSeparatedConstraints = True }
,testStatement ansi2011{ diNonCommaSeparatedConstraints = True }
"create table t (a int, b int,\n\
\ foreign key (a) references u(c)\n\
\ foreign key (b) references v(d));"
@ -697,7 +699,7 @@ defintely skip
(Just [Name Nothing "d"])
DefaultReferenceMatch
DefaultReferentialAction DefaultReferentialAction
])
]
{-
@ -755,7 +757,7 @@ defintely skip
CHECK <left paren> <search condition> <right paren>
-}
,(TestStatement ansi2011
,s
"create table t (a int, b int, \n\
\ check (a > b));"
$ CreateTable [Name Nothing "t"]
@ -764,10 +766,10 @@ defintely skip
,TableConstraintDef Nothing $
TableCheckConstraint
(BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))
])
]
,(TestStatement ansi2011
,s
"create table t (a int, b int, \n\
\ constraint agtb check (a > b));"
$ CreateTable [Name Nothing "t"]
@ -776,7 +778,7 @@ defintely skip
,TableConstraintDef (Just [Name Nothing "agtb"]) $
TableCheckConstraint
(BinOp (Iden [Name Nothing "a"]) [Name Nothing ">"] (Iden [Name Nothing "b"]))
])
]
{-
@ -810,11 +812,10 @@ alter table t add a int
alter table t add a int unique not null check (a>0)
-}
,(TestStatement ansi2011
,s
"alter table t add column a int"
$ AlterTable [Name Nothing "t"] $ AddColumnDef
$ ColumnDef (Name Nothing "a") (TypeName [Name Nothing "int"]) Nothing []
)
{-
todo: more add column
@ -844,10 +845,10 @@ todo: more add column
-}
,(TestStatement ansi2011
,s
"alter table t alter column c set default 0"
$ AlterTable [Name Nothing "t"] $ AlterColumnSetDefault (Name Nothing "c")
$ NumLit "0")
$ NumLit "0"
{-
11.14 <drop column default clause>
@ -856,9 +857,9 @@ todo: more add column
DROP DEFAULT
-}
,(TestStatement ansi2011
,s
"alter table t alter column c drop default"
$ AlterTable [Name Nothing "t"] $ AlterColumnDropDefault (Name Nothing "c"))
$ AlterTable [Name Nothing "t"] $ AlterColumnDropDefault (Name Nothing "c")
{-
@ -868,9 +869,9 @@ todo: more add column
SET NOT NULL
-}
,(TestStatement ansi2011
,s
"alter table t alter column c set not null"
$ AlterTable [Name Nothing "t"] $ AlterColumnSetNotNull (Name Nothing "c"))
$ AlterTable [Name Nothing "t"] $ AlterColumnSetNotNull (Name Nothing "c")
{-
11.16 <drop column not null clause>
@ -879,9 +880,9 @@ todo: more add column
DROP NOT NULL
-}
,(TestStatement ansi2011
,s
"alter table t alter column c drop not null"
$ AlterTable [Name Nothing "t"] $ AlterColumnDropNotNull (Name Nothing "c"))
$ AlterTable [Name Nothing "t"] $ AlterColumnDropNotNull (Name Nothing "c")
{-
11.17 <add column scope clause>
@ -900,10 +901,10 @@ todo: more add column
SET DATA TYPE <data type>
-}
,(TestStatement ansi2011
,s
"alter table t alter column c set data type int;"
$ AlterTable [Name Nothing "t"] $
AlterColumnSetDataType (Name Nothing "c") (TypeName [Name Nothing "int"]))
AlterColumnSetDataType (Name Nothing "c") (TypeName [Name Nothing "int"])
@ -1001,20 +1002,20 @@ included in the generated plan above
DROP [ COLUMN ] <column name> <drop behavior>
-}
,(TestStatement ansi2011
,s
"alter table t drop column c"
$ AlterTable [Name Nothing "t"] $
DropColumn (Name Nothing "c") DefaultDropBehaviour)
DropColumn (Name Nothing "c") DefaultDropBehaviour
,(TestStatement ansi2011
,s
"alter table t drop c cascade"
$ AlterTable [Name Nothing "t"] $
DropColumn (Name Nothing "c") Cascade)
DropColumn (Name Nothing "c") Cascade
,(TestStatement ansi2011
,s
"alter table t drop c restrict"
$ AlterTable [Name Nothing "t"] $
DropColumn (Name Nothing "c") Restrict)
DropColumn (Name Nothing "c") Restrict
@ -1025,17 +1026,17 @@ included in the generated plan above
ADD <table constraint definition>
-}
,(TestStatement ansi2011
,s
"alter table t add constraint c unique (a,b)"
$ AlterTable [Name Nothing "t"] $
AddTableConstraintDef (Just [Name Nothing "c"])
$ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])
$ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]
,(TestStatement ansi2011
,s
"alter table t add unique (a,b)"
$ AlterTable [Name Nothing "t"] $
AddTableConstraintDef Nothing
$ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"])
$ TableUniqueConstraint [Name Nothing "a", Name Nothing "b"]
{-
@ -1051,15 +1052,15 @@ todo
DROP CONSTRAINT <constraint name> <drop behavior>
-}
,(TestStatement ansi2011
,s
"alter table t drop constraint c"
$ AlterTable [Name Nothing "t"] $
DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour)
DropTableConstraintDef [Name Nothing "c"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"alter table t drop constraint c restrict"
$ AlterTable [Name Nothing "t"] $
DropTableConstraintDef [Name Nothing "c"] Restrict)
DropTableConstraintDef [Name Nothing "c"] Restrict
{-
11.27 <add table period definition>
@ -1111,13 +1112,13 @@ defintely skip
DROP TABLE <table name> <drop behavior>
-}
,(TestStatement ansi2011
,s
"drop table t"
$ DropTable [Name Nothing "t"] DefaultDropBehaviour)
$ DropTable [Name Nothing "t"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"drop table t restrict"
$ DropTable [Name Nothing "t"] Restrict)
$ DropTable [Name Nothing "t"] Restrict
{-
@ -1159,51 +1160,51 @@ defintely skip
<column name list>
-}
,(TestStatement ansi2011
,s
"create view v as select * from t"
$ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}) Nothing)
}) Nothing
,(TestStatement ansi2011
,s
"create recursive view v as select * from t"
$ CreateView True [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}) Nothing)
}) Nothing
,(TestStatement ansi2011
,s
"create view v(a,b) as select * from t"
$ CreateView False [Name Nothing "v"] (Just [Name Nothing "a", Name Nothing "b"])
(toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}) Nothing)
}) Nothing
,(TestStatement ansi2011
,s
"create view v as select * from t with check option"
$ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}) (Just DefaultCheckOption))
}) (Just DefaultCheckOption)
,(TestStatement ansi2011
,s
"create view v as select * from t with cascaded check option"
$ CreateView False [Name Nothing "v"] Nothing (toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}) (Just CascadedCheckOption))
}) (Just CascadedCheckOption)
,(TestStatement ansi2011
,s
"create view v as select * from t with local check option"
$ CreateView False [Name Nothing "v"] Nothing
(toQueryExpr $ makeSelect
{msSelectList = [(Star, Nothing)]
,msFrom = [TRSimple [Name Nothing "t"]]
}) (Just LocalCheckOption))
}) (Just LocalCheckOption)
{-
@ -1214,13 +1215,13 @@ defintely skip
-}
,(TestStatement ansi2011
,s
"drop view v"
$ DropView [Name Nothing "v"] DefaultDropBehaviour)
$ DropView [Name Nothing "v"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"drop view v cascade"
$ DropView [Name Nothing "v"] Cascade)
$ DropView [Name Nothing "v"] Cascade
{-
@ -1237,37 +1238,37 @@ defintely skip
<constraint characteristics> ]
-}
,(TestStatement ansi2011
,s
"create domain my_int int"
$ CreateDomain [Name Nothing "my_int"]
(TypeName [Name Nothing "int"])
Nothing [])
Nothing []
,(TestStatement ansi2011
,s
"create domain my_int as int"
$ CreateDomain [Name Nothing "my_int"]
(TypeName [Name Nothing "int"])
Nothing [])
Nothing []
,(TestStatement ansi2011
,s
"create domain my_int int default 0"
$ CreateDomain [Name Nothing "my_int"]
(TypeName [Name Nothing "int"])
(Just (NumLit "0")) [])
(Just (NumLit "0")) []
,(TestStatement ansi2011
,s
"create domain my_int int check (value > 5)"
$ CreateDomain [Name Nothing "my_int"]
(TypeName [Name Nothing "int"])
Nothing [(Nothing
,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])
,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))]
,(TestStatement ansi2011
,s
"create domain my_int int constraint gt5 check (value > 5)"
$ CreateDomain [Name Nothing "my_int"]
(TypeName [Name Nothing "int"])
Nothing [(Just [Name Nothing "gt5"]
,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))])
,BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "5"))]
@ -1289,10 +1290,10 @@ defintely skip
SET <default clause>
-}
,(TestStatement ansi2011
,s
"alter domain my_int set default 0"
$ AlterDomain [Name Nothing "my_int"]
$ ADSetDefault $ NumLit "0")
$ ADSetDefault $ NumLit "0"
{-
@ -1302,10 +1303,10 @@ defintely skip
DROP DEFAULT
-}
,(TestStatement ansi2011
,s
"alter domain my_int drop default"
$ AlterDomain [Name Nothing "my_int"]
$ ADDropDefault)
$ ADDropDefault
{-
@ -1315,17 +1316,17 @@ defintely skip
ADD <domain constraint>
-}
,(TestStatement ansi2011
,s
"alter domain my_int add check (value > 6)"
$ AlterDomain [Name Nothing "my_int"]
$ ADAddConstraint Nothing
$ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))
$ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6")
,(TestStatement ansi2011
,s
"alter domain my_int add constraint gt6 check (value > 6)"
$ AlterDomain [Name Nothing "my_int"]
$ ADAddConstraint (Just [Name Nothing "gt6"])
$ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6"))
$ BinOp (Iden [Name Nothing "value"]) [Name Nothing ">"] (NumLit "6")
{-
@ -1335,10 +1336,10 @@ defintely skip
DROP CONSTRAINT <constraint name>
-}
,(TestStatement ansi2011
,s
"alter domain my_int drop constraint gt6"
$ AlterDomain [Name Nothing "my_int"]
$ ADDropConstraint [Name Nothing "gt6"])
$ ADDropConstraint [Name Nothing "gt6"]
{-
11.40 <drop domain statement>
@ -1347,13 +1348,13 @@ defintely skip
DROP DOMAIN <domain name> <drop behavior>
-}
,(TestStatement ansi2011
,s
"drop domain my_int"
$ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour)
$ DropDomain [Name Nothing "my_int"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"drop domain my_int cascade"
$ DropDomain [Name Nothing "my_int"] Cascade)
$ DropDomain [Name Nothing "my_int"] Cascade
@ -1425,7 +1426,7 @@ defintely skip
[ <constraint characteristics> ]
-}
,(TestStatement ansi2011
,s
"create assertion t1_not_empty CHECK ((select count(*) from t1) > 0);"
$ CreateAssertion [Name Nothing "t1_not_empty"]
$ BinOp (SubQueryExpr SqSq $
@ -1433,7 +1434,7 @@ defintely skip
{msSelectList = [(App [Name Nothing "count"] [Star],Nothing)]
,msFrom = [TRSimple [Name Nothing "t1"]]
})
[Name Nothing ">"] (NumLit "0"))
[Name Nothing ">"] (NumLit "0")
{-
11.48 <drop assertion statement>
@ -1442,13 +1443,13 @@ defintely skip
DROP ASSERTION <constraint name> [ <drop behavior> ]
-}
,(TestStatement ansi2011
,s
"drop assertion t1_not_empty;"
$ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour)
$ DropAssertion [Name Nothing "t1_not_empty"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"drop assertion t1_not_empty cascade;"
$ DropAssertion [Name Nothing "t1_not_empty"] Cascade)
$ DropAssertion [Name Nothing "t1_not_empty"] Cascade
{-
@ -2085,21 +2086,21 @@ defintely skip
| NO CYCLE
-}
,(TestStatement ansi2011
,s
"create sequence seq"
$ CreateSequence [Name Nothing "seq"] [])
$ CreateSequence [Name Nothing "seq"] []
,(TestStatement ansi2011
,s
"create sequence seq as bigint"
$ CreateSequence [Name Nothing "seq"]
[SGODataType $ TypeName [Name Nothing "bigint"]])
[SGODataType $ TypeName [Name Nothing "bigint"]]
,(TestStatement ansi2011
,s
"create sequence seq as bigint start with 5"
$ CreateSequence [Name Nothing "seq"]
[SGOStartWith 5
,SGODataType $ TypeName [Name Nothing "bigint"]
])
]
{-
@ -2122,21 +2123,21 @@ defintely skip
<signed numeric literal>
-}
,(TestStatement ansi2011
,s
"alter sequence seq restart"
$ AlterSequence [Name Nothing "seq"]
[SGORestart Nothing])
[SGORestart Nothing]
,(TestStatement ansi2011
,s
"alter sequence seq restart with 5"
$ AlterSequence [Name Nothing "seq"]
[SGORestart $ Just 5])
[SGORestart $ Just 5]
,(TestStatement ansi2011
,s
"alter sequence seq restart with 5 increment by 5"
$ AlterSequence [Name Nothing "seq"]
[SGORestart $ Just 5
,SGOIncrementBy 5])
,SGOIncrementBy 5]
{-
@ -2146,13 +2147,16 @@ defintely skip
DROP SEQUENCE <sequence generator name> <drop behavior>
-}
,(TestStatement ansi2011
,s
"drop sequence seq"
$ DropSequence [Name Nothing "seq"] DefaultDropBehaviour)
$ DropSequence [Name Nothing "seq"] DefaultDropBehaviour
,(TestStatement ansi2011
,s
"drop sequence seq restrict"
$ DropSequence [Name Nothing "seq"] Restrict)
$ DropSequence [Name Nothing "seq"] Restrict
]
s :: HasCallStack => Text -> Statement -> TestItem
s src ast = testStatement ansi2011 src ast

466
tests/Language/SQL/SimpleSQL/ScalarExprs.hs
View file

@ -6,6 +6,9 @@ module Language.SQL.SimpleSQL.ScalarExprs (scalarExprTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
scalarExprTests :: TestItem
scalarExprTests = Group "scalarExprTests"
@ -25,101 +28,108 @@ scalarExprTests = Group "scalarExprTests"
,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")
]
t :: HasCallStack => Text -> ScalarExpr -> TestItem
t src ast = testScalarExpr ansi2011 src ast
td :: HasCallStack => Dialect -> Text -> ScalarExpr -> TestItem
td d src ast = testScalarExpr d src ast
literals :: TestItem
literals = Group "literals"
[t "3" $ NumLit "3"
,t "3." $ NumLit "3."
,t "3.3" $ NumLit "3.3"
,t ".3" $ NumLit ".3"
,t "3.e3" $ NumLit "3.e3"
,t "3.3e3" $ NumLit "3.3e3"
,t ".3e3" $ NumLit ".3e3"
,t "3e3" $ NumLit "3e3"
,t "3e+3" $ NumLit "3e+3"
,t "3e-3" $ NumLit "3e-3"
,t "'string'" $ StringLit "'" "'" "string"
,t "'string with a '' quote'" $ StringLit "'" "'" "string with a '' quote"
,t "'1'" $ StringLit "'" "'" "1"
,t "interval '3' day"
$ IntervalLit Nothing "3" (Itf "day" Nothing) Nothing
,t "interval '3' day (3)"
$ IntervalLit Nothing "3" (Itf "day" $ Just (3,Nothing)) Nothing
,t "interval '3 weeks'" $ TypedLit (TypeName [Name Nothing "interval"]) "3 weeks"
]
identifiers :: TestItem
identifiers = Group "identifiers" $ map (uncurry (TestScalarExpr ansi2011))
[("iden1", Iden [Name Nothing "iden1"])
identifiers = Group "identifiers"
[t "iden1" $ Iden [Name Nothing "iden1"]
--,("t.a", Iden2 "t" "a")
,("\"quoted identifier\"", Iden [Name (Just ("\"","\"")) "quoted identifier"])
,("\"from\"", Iden [Name (Just ("\"","\"")) "from"])
,t "\"quoted identifier\"" $ Iden [Name (Just ("\"","\"")) "quoted identifier"]
,t "\"from\"" $ Iden [Name (Just ("\"","\"")) "from"]
]
star :: TestItem
star = Group "star" $ map (uncurry (TestScalarExpr ansi2011))
[("*", Star)
star = Group "star"
[t "*" 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]
[td ansi2011 "?" Parameter
,td 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"])
dots = Group "dot"
[t "t.a" $ Iden [Name Nothing "t",Name Nothing "a"]
,t "t.*" $ BinOp (Iden [Name Nothing "t"]) [Name Nothing "."] Star
,t "a.b.c" $ Iden [Name Nothing "a",Name Nothing "b",Name Nothing "c"]
,t "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"]])
app = Group "app"
[t "f()" $ App [Name Nothing "f"] []
,t "f(a)" $ App [Name Nothing "f"] [Iden [Name Nothing "a"]]
,t "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)
caseexp = Group "caseexp"
[t "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)
,t "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")
,t "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"))
(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")
,t "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"))
(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"]
,t "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)
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))
convertfun = Group "convert"
[td sqlserver "CONVERT(varchar, 25.65)"
$ Convert (TypeName [Name Nothing "varchar"]) (NumLit "25.65") Nothing
,td sqlserver "CONVERT(datetime, '2017-08-25')"
$ Convert (TypeName [Name Nothing "datetime"]) (StringLit "'" "'" "2017-08-25") Nothing
,td sqlserver "CONVERT(varchar, '2017-08-25', 101)"
$ Convert (TypeName [Name Nothing "varchar"]) (StringLit "'" "'" "2017-08-25") (Just 101)
]
operators :: TestItem
@ -130,70 +140,69 @@ operators = Group "operators"
,miscOps]
binaryOperators :: TestItem
binaryOperators = Group "binaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
[("a + b", BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))
binaryOperators = Group "binaryOperators"
[t "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"])))
,t "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"]))
,t "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"])
unaryOperators = Group "unaryOperators"
[t "not a" $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"]
,t "not not a" $ PrefixOp [Name Nothing "not"] $ PrefixOp [Name Nothing "not"] $ Iden [Name Nothing "a"]
,t "+a" $ PrefixOp [Name Nothing "+"] $ Iden [Name Nothing "a"]
,t "-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"])
casts = Group "operators"
[t "cast('1' as int)"
$ Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "int"]
,("int '3'"
,TypedLit (TypeName [Name Nothing "int"]) "3")
,t "int '3'"
$ TypedLit (TypeName [Name Nothing "int"]) "3"
,("cast('1' as double precision)"
,Cast (StringLit "'" "'" "1") $ TypeName [Name Nothing "double precision"])
,t "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)
,t "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)
,t "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")
,t "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)
subqueries = Group "unaryOperators"
[t "exists (select a from t)" $ SubQueryExpr SqExists ms
,t "(select a from t)" $ SubQueryExpr SqSq ms
,("a in (select a from t)"
,In True (Iden [Name Nothing "a"]) (InQueryExpr ms))
,t "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))
,t "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)
,t "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)
,t "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)
,t "a <= any (select a from t)"
$ QuantifiedComparison (Iden [Name Nothing "a"]) [Name Nothing "<="] CPAny ms
]
where
ms = toQueryExpr $ makeSelect
@ -202,94 +211,93 @@ subqueries = Group "unaryOperators" $ map (uncurry (TestScalarExpr ansi2011))
}
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"])
miscOps = Group "unaryOperators"
[t "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"]))
,t "a is null" $ PostfixOp [Name Nothing "is null"] (Iden [Name Nothing "a"])
,t "a is not null" $ PostfixOp [Name Nothing "is not null"] (Iden [Name Nothing "a"])
,t "a is true" $ PostfixOp [Name Nothing "is true"] (Iden [Name Nothing "a"])
,t "a is not true" $ PostfixOp [Name Nothing "is not true"] (Iden [Name Nothing "a"])
,t "a is false" $ PostfixOp [Name Nothing "is false"] (Iden [Name Nothing "a"])
,t "a is not false" $ PostfixOp [Name Nothing "is not false"] (Iden [Name Nothing "a"])
,t "a is unknown" $ PostfixOp [Name Nothing "is unknown"] (Iden [Name Nothing "a"])
,t "a is not unknown" $ PostfixOp [Name Nothing "is not unknown"] (Iden [Name Nothing "a"])
,t "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"]))
,t "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"]))
,t "a like b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "like"] (Iden [Name Nothing "b"])
,t "a not like b" $ BinOp (Iden [Name Nothing "a"]) [Name Nothing "not like"] (Iden [Name Nothing "b"])
,t "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"]))
,t "a is not similar to b"
$ BinOp (Iden [Name Nothing "a"]) [Name Nothing "is not similar to"] (Iden [Name Nothing "b"])
,t "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"]
,t "a between b and c" $ SpecialOp [Name Nothing "between"] [Iden [Name Nothing "a"]
,Iden [Name Nothing "b"]
,Iden [Name Nothing "c"]])
,Iden [Name Nothing "c"]]
,("a not between b and c", SpecialOp [Name Nothing "not between"] [Iden [Name Nothing "a"]
,t "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"])
,Iden [Name Nothing "c"]]
,t "(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"])])
,t "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")])
,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")])
,t "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")])
,t "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"])
,t "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"])])
,("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"])])
,t "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"])])
,t "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"])])
,t "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"])
,t "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"])])
,("from", Iden [Name Nothing "start"])]
,("OVERLAY(string PLACING embedded_string FROM start FOR length)"
,SpecialOpK [Name Nothing "overlay"] (Just $ Iden [Name Nothing "string"])
,t "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"])])
,("for", Iden [Name Nothing "length"])]
{-
TRIM( [ [{LEADING | TRAILING | BOTH}] [removal_char] FROM ]
@ -299,135 +307,133 @@ target_string
,("trim(from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("both", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
,("trim(leading from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(leading from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("leading", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
,("trim(trailing from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(trailing from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("trailing", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
,("trim(both from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(both from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("both", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
,("trim(leading 'x' from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(leading 'x' from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("leading", StringLit "'" "'" "x")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
,("trim(trailing 'y' from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(trailing 'y' from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("trailing", StringLit "'" "'" "y")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
,("trim(both 'z' from target_string collate C)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "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"])])
,("from", Collate (Iden [Name Nothing "target_string"]) [Name Nothing "C"])]
,("trim(leading from target_string)"
,SpecialOpK [Name Nothing "trim"] Nothing
,t "trim(leading from target_string)"
$ SpecialOpK [Name Nothing "trim"] Nothing
[("leading", StringLit "'" "'" " ")
,("from", Iden [Name Nothing "target_string"])])
,("from", Iden [Name Nothing "target_string"])]
]
aggregates :: TestItem
aggregates = Group "aggregates" $ map (uncurry (TestScalarExpr ansi2011))
[("count(*)",App [Name Nothing "count"] [Star])
aggregates = Group "aggregates"
[t "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)
,t "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)
,t "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)
,t "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)
windowFunctions = Group "windowFunctions"
[t "max(a) over ()" $ WindowApp [Name Nothing "max"] [Iden [Name Nothing "a"]] [] [] Nothing
,t "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)
,t "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)
,t "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)
,t "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"]] []
,t "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)
,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)
,t "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"]]
,t "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)
$ 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"]]
,t "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"))
$ 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"]]
,t "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)
$ 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"]]
,t "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"))
$ 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"]]
,t "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)
$ Just $ FrameFrom FrameRange UnboundedFollowing
,("sum(a) over (partition by b order by c \n\
,t "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"]]
$ 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")))
(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"])))
parens = Group "parens"
[t "(a)" $ Parens (Iden [Name Nothing "a"])
,t "(a + b)" $ Parens (BinOp (Iden [Name Nothing "a"]) [Name Nothing "+"] (Iden [Name Nothing "b"]))
]
functionsWithReservedNames :: TestItem
functionsWithReservedNames = Group "functionsWithReservedNames" $ map t
functionsWithReservedNames = Group "functionsWithReservedNames" $ map f
["abs"
,"char_length"
]
where
t fn = TestScalarExpr ansi2011 (fn <> "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]
f fn = t (fn <> "(a)") $ App [Name Nothing fn] [Iden [Name Nothing "a"]]

123
tests/Language/SQL/SimpleSQL/TableRefs.hs
View file

@ -9,100 +9,103 @@ module Language.SQL.SimpleSQL.TableRefs (tableRefTests) where
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestRunners
import Data.Text (Text)
tableRefTests :: TestItem
tableRefTests = Group "tableRefTests" $ map (uncurry (TestQueryExpr ansi2011))
[("select a from t"
,ms [TRSimple [Name Nothing "t"]])
tableRefTests = Group "tableRefTests"
[q "select a from t"
$ ms [TRSimple [Name Nothing "t"]]
,("select a from f(a)"
,ms [TRFunction [Name Nothing "f"] [Iden [Name Nothing "a"]]])
,q "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"]])
,q "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"]])
,q "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"]])
,q "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"]])
,q "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"]])
,q "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
,q "select a from a natural join lateral b"
$ ms [TRJoin (TRSimple [Name Nothing "a"]) True JInner
(TRLateral $ TRSimple [Name Nothing "b"])
Nothing])
Nothing]
,("select a from lateral a natural join lateral b"
,ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner
,q "select a from lateral a natural join lateral b"
$ ms [TRJoin (TRLateral $ TRSimple [Name Nothing "a"]) True JInner
(TRLateral $ TRSimple [Name Nothing "b"])
Nothing])
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"])])
,q "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"])])
,q "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"])])
,q "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"])])
,q "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"])])
,q "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])
,q "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])
,q "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"])])
,q "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"]]])
,q "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)])
,q "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)])
,q "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"])])
,q "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 $
,q "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)])
(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
,q "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])
False JCross (TRSimple [Name Nothing "v"]) Nothing]
]
where
ms f = toQueryExpr $ makeSelect {msSelectList = [(Iden [Name Nothing "a"],Nothing)]
,msFrom = f}
q :: HasCallStack => Text -> QueryExpr -> TestItem
q src ast = testQueryExpr ansi2011 src ast

92
tests/Language/SQL/SimpleSQL/TestRunners.hs Normal file
View file

@ -0,0 +1,92 @@
{-# LANGUAGE OverloadedStrings #-}
module Language.SQL.SimpleSQL.TestRunners
(testLex
,lexFails
,testScalarExpr
,testQueryExpr
,testStatement
,testStatements
,testParseQueryExpr
,testParseQueryExprFails
,testParseScalarExprFails
,HasCallStack
) where
import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.TestTypes
import Language.SQL.SimpleSQL.Pretty
import Language.SQL.SimpleSQL.Parse
import qualified Language.SQL.SimpleSQL.Lex as Lex
import Data.Text (Text)
import qualified Data.Text as T
import Language.SQL.SimpleSQL.Expectations
(shouldParseL
,shouldFail
,shouldParseA
,shouldSucceed
)
import Test.Hspec
(it
,HasCallStack
)
testLex :: HasCallStack => Dialect -> Text -> [Lex.Token] -> TestItem
testLex d input a =
LexTest d input a $ do
it (T.unpack input) $ Lex.lexSQL d False "" Nothing input `shouldParseL` a
it (T.unpack $ "pp: " <> input) $ Lex.lexSQL d False "" Nothing (Lex.prettyTokens d a) `shouldParseL` a
lexFails :: HasCallStack => Dialect -> Text -> TestItem
lexFails d input =
LexFails d input $
it (T.unpack input) $ shouldFail $ Lex.lexSQL d False "" Nothing input
testScalarExpr :: HasCallStack => Dialect -> Text -> ScalarExpr -> TestItem
testScalarExpr d input a =
TestScalarExpr d input a $ do
it (T.unpack input) $ parseScalarExpr d "" Nothing input `shouldParseA` a
it (T.unpack $ "pp: " <> input) $ parseScalarExpr d "" Nothing (prettyScalarExpr d a) `shouldParseA` a
testQueryExpr :: HasCallStack => Dialect -> Text -> QueryExpr -> TestItem
testQueryExpr d input a =
TestQueryExpr d input a $ do
it (T.unpack input) $ parseQueryExpr d "" Nothing input `shouldParseA` a
it (T.unpack $ "pp: " <> input) $ parseQueryExpr d "" Nothing (prettyQueryExpr d a) `shouldParseA` a
testParseQueryExpr :: HasCallStack => Dialect -> Text -> TestItem
testParseQueryExpr d input =
let a = parseQueryExpr d "" Nothing input
in ParseQueryExpr d input $ do
it (T.unpack input) $ shouldSucceed (T.unpack . prettyError) a
case a of
Left _ -> pure ()
Right a' ->
it (T.unpack $ "pp: " <> input) $
parseQueryExpr d "" Nothing (prettyQueryExpr d a') `shouldParseA` a'
testParseQueryExprFails :: HasCallStack => Dialect -> Text -> TestItem
testParseQueryExprFails d input =
ParseQueryExprFails d input $
it (T.unpack input) $ shouldFail $ parseQueryExpr d "" Nothing input
testParseScalarExprFails :: HasCallStack => Dialect -> Text -> TestItem
testParseScalarExprFails d input =
ParseScalarExprFails d input $
it (T.unpack input) $ shouldFail $ parseScalarExpr d "" Nothing input
testStatement :: HasCallStack => Dialect -> Text -> Statement -> TestItem
testStatement d input a =
TestStatement d input a $ do
it (T.unpack input) $ parseStatement d "" Nothing input `shouldParseA` a
it (T.unpack $ "pp: " <> input) $ parseStatement d "" Nothing (prettyStatement d a) `shouldParseA` a
testStatements :: HasCallStack => Dialect -> Text -> [Statement] -> TestItem
testStatements d input a =
TestStatements d input a $ do
it (T.unpack input) $ parseStatements d "" Nothing input `shouldParseA` a
it (T.unpack $ "pp: " <> input) $ parseStatements d "" Nothing (prettyStatements d a) `shouldParseA` a

30
tests/Language/SQL/SimpleSQL/TestTypes.hs
View file

@ -13,6 +13,9 @@ import Language.SQL.SimpleSQL.Syntax
import Language.SQL.SimpleSQL.Lex (Token)
import Language.SQL.SimpleSQL.Dialect
import Test.Hspec (SpecWith)
import Data.Text (Text)
{-
@ -20,13 +23,19 @@ 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.
The test items are designed to allow code to grab all the examples
in easily usable data types, but since hspec has this neat feature
where it will give a source location for a test failure, each testitem
apart from group already has the SpecWith attached to run that test,
that way we can attach the source location to each test item
-}
data TestItem = Group Text [TestItem]
| TestScalarExpr Dialect Text ScalarExpr
| TestQueryExpr Dialect Text QueryExpr
| TestStatement Dialect Text Statement
| TestStatements Dialect Text [Statement]
| TestScalarExpr Dialect Text ScalarExpr (SpecWith ())
| TestQueryExpr Dialect Text QueryExpr (SpecWith ())
| TestStatement Dialect Text Statement (SpecWith ())
| TestStatements Dialect Text [Statement] (SpecWith ())
{-
this just checks the sql parses without error, mostly just a
@ -34,12 +43,13 @@ 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
| ParseQueryExpr Dialect Text (SpecWith ())
-- check that the string given fails to parse
| ParseQueryExprFails Dialect Text
| ParseScalarExprFails Dialect Text
| LexTest Dialect Text [Token]
| LexFails Dialect Text
deriving (Eq,Show)
| ParseQueryExprFails Dialect Text (SpecWith ())
| ParseScalarExprFails Dialect Text (SpecWith ())
| LexTest Dialect Text [Token] (SpecWith ())
| LexFails Dialect Text (SpecWith ())
| GeneralParseFailTest Text Text (SpecWith ())

127
tests/Language/SQL/SimpleSQL/Tests.hs
View file

@ -12,13 +12,11 @@ module Language.SQL.SimpleSQL.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 Test.Hspec
(SpecWith
,describe
,parallel
)
import Language.SQL.SimpleSQL.TestTypes
@ -44,11 +42,10 @@ import Language.SQL.SimpleSQL.SQL2011Schema
import Language.SQL.SimpleSQL.MySQL
import Language.SQL.SimpleSQL.Oracle
import Language.SQL.SimpleSQL.CustomDialect
import Language.SQL.SimpleSQL.ErrorMessages
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.
@ -77,104 +74,22 @@ testData =
,customDialectTests
,emptyStatementTests
,createIndexTests
,errorMessageTests
]
tests :: T.TestTree
tests = itemToTest testData
tests :: SpecWith ()
tests = parallel $ itemToTest testData
--runTests :: IO ()
--runTests = void $ H.runTestTT $ itemToTest testData
itemToTest :: TestItem -> T.TestTree
itemToTest :: TestItem -> SpecWith ()
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
describe (T.unpack nm) $ mapM_ itemToTest ts
itemToTest (TestScalarExpr _ _ _ t) = t
itemToTest (TestQueryExpr _ _ _ t) = t
itemToTest (TestStatement _ _ _ t) = t
itemToTest (TestStatements _ _ _ t) = t
itemToTest (ParseQueryExpr _ _ t) = t
itemToTest (ParseQueryExprFails _ _ t) = t
itemToTest (ParseScalarExprFails _ _ t) = t
itemToTest (LexTest _ _ _ t) = t
itemToTest (LexFails _ _ t) = t
itemToTest (GeneralParseFailTest _ _ t) = t

98
tests/Language/SQL/SimpleSQL/Tpch.hs
View file

@ -14,15 +14,14 @@ module Language.SQL.SimpleSQL.Tpch (tpchTests,tpchQueries) where
import Language.SQL.SimpleSQL.TestTypes
import Data.Text (Text)
import Language.SQL.SimpleSQL.TestRunners
tpchTests :: TestItem
tpchTests =
Group "parse tpch"
$ map (ParseQueryExpr ansi2011 . snd) tpchQueries
tpchTests = Group "parse tpch" tpchQueries
tpchQueries :: [(String,Text)]
tpchQueries :: [TestItem]
tpchQueries =
[("Q1","\n\
[q "Q1" "\n\
\select\n\
\ l_returnflag,\n\
\ l_linestatus,\n\
@ -43,8 +42,8 @@ tpchQueries =
\ l_linestatus\n\
\order by\n\
\ l_returnflag,\n\
\ l_linestatus")
,("Q2","\n\
\ l_linestatus"
,q "Q2" "\n\
\select\n\
\ s_acctbal,\n\
\ s_name,\n\
@ -88,8 +87,8 @@ tpchQueries =
\ n_name,\n\
\ s_name,\n\
\ p_partkey\n\
\fetch first 100 rows only")
,("Q3","\n\
\fetch first 100 rows only"
,q "Q3" "\n\
\ select\n\
\ l_orderkey,\n\
\ sum(l_extendedprice * (1 - l_discount)) as revenue,\n\
@ -112,8 +111,8 @@ tpchQueries =
\ order by\n\
\ revenue desc,\n\
\ o_orderdate\n\
\ fetch first 10 rows only")
,("Q4","\n\
\ fetch first 10 rows only"
,q "Q4" "\n\
\ select\n\
\ o_orderpriority,\n\
\ count(*) as order_count\n\
@ -134,8 +133,8 @@ tpchQueries =
\ group by\n\
\ o_orderpriority\n\
\ order by\n\
\ o_orderpriority")
,("Q5","\n\
\ o_orderpriority"
,q "Q5" "\n\
\ select\n\
\ n_name,\n\
\ sum(l_extendedprice * (1 - l_discount)) as revenue\n\
@ -159,8 +158,8 @@ tpchQueries =
\ group by\n\
\ n_name\n\
\ order by\n\
\ revenue desc")
,("Q6","\n\
\ revenue desc"
,q "Q6" "\n\
\ select\n\
\ sum(l_extendedprice * l_discount) as revenue\n\
\ from\n\
@ -169,8 +168,8 @@ tpchQueries =
\ 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\
\ and l_quantity < 24"
,q "Q7" "\n\
\ select\n\
\ supp_nation,\n\
\ cust_nation,\n\
@ -209,8 +208,8 @@ tpchQueries =
\ order by\n\
\ supp_nation,\n\
\ cust_nation,\n\
\ l_year")
,("Q8","\n\
\ l_year"
,q "Q8" "\n\
\ select\n\
\ o_year,\n\
\ sum(case\n\
@ -247,8 +246,8 @@ tpchQueries =
\ group by\n\
\ o_year\n\
\ order by\n\
\ o_year")
,("Q9","\n\
\ o_year"
,q "Q9" "\n\
\ select\n\
\ nation,\n\
\ o_year,\n\
@ -280,8 +279,8 @@ tpchQueries =
\ o_year\n\
\ order by\n\
\ nation,\n\
\ o_year desc")
,("Q10","\n\
\ o_year desc"
,q "Q10" "\n\
\ select\n\
\ c_custkey,\n\
\ c_name,\n\
@ -313,8 +312,8 @@ tpchQueries =
\ c_comment\n\
\ order by\n\
\ revenue desc\n\
\ fetch first 20 rows only")
,("Q11","\n\
\ fetch first 20 rows only"
,q "Q11" "\n\
\ select\n\
\ ps_partkey,\n\
\ sum(ps_supplycost * ps_availqty) as value\n\
@ -341,8 +340,8 @@ tpchQueries =
\ and n_name = 'CHINA'\n\
\ )\n\
\ order by\n\
\ value desc")
,("Q12","\n\
\ value desc"
,q "Q12" "\n\
\ select\n\
\ l_shipmode,\n\
\ sum(case\n\
@ -370,8 +369,8 @@ tpchQueries =
\ group by\n\
\ l_shipmode\n\
\ order by\n\
\ l_shipmode")
,("Q13","\n\
\ l_shipmode"
,q "Q13" "\n\
\ select\n\
\ c_count,\n\
\ count(*) as custdist\n\
@ -391,8 +390,8 @@ tpchQueries =
\ c_count\n\
\ order by\n\
\ custdist desc,\n\
\ c_count desc")
,("Q14","\n\
\ c_count desc"
,q "Q14" "\n\
\ select\n\
\ 100.00 * sum(case\n\
\ when p_type like 'PROMO%'\n\
@ -405,8 +404,8 @@ tpchQueries =
\ 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\
\ and l_shipdate < date '1994-12-01' + interval '1' month"
,q "Q15" "\n\
\ /*create view revenue0 (supplier_no, total_revenue) as\n\
\ select\n\
\ l_suppkey,\n\
@ -448,8 +447,8 @@ tpchQueries =
\ revenue0\n\
\ )\n\
\ order by\n\
\ s_suppkey")
,("Q16","\n\
\ s_suppkey"
,q "Q16" "\n\
\ select\n\
\ p_brand,\n\
\ p_type,\n\
@ -479,8 +478,8 @@ tpchQueries =
\ supplier_cnt desc,\n\
\ p_brand,\n\
\ p_type,\n\
\ p_size")
,("Q17","\n\
\ p_size"
,q "Q17" "\n\
\ select\n\
\ sum(l_extendedprice) / 7.0 as avg_yearly\n\
\ from\n\
@ -497,8 +496,8 @@ tpchQueries =
\ lineitem\n\
\ where\n\
\ l_partkey = p_partkey\n\
\ )")
,("Q18","\n\
\ )"
,q "Q18" "\n\
\ select\n\
\ c_name,\n\
\ c_custkey,\n\
@ -531,8 +530,8 @@ tpchQueries =
\ order by\n\
\ o_totalprice desc,\n\
\ o_orderdate\n\
\ fetch first 100 rows only")
,("Q19","\n\
\ fetch first 100 rows only"
,q "Q19" "\n\
\ select\n\
\ sum(l_extendedprice* (1 - l_discount)) as revenue\n\
\ from\n\
@ -567,8 +566,8 @@ tpchQueries =
\ 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\
\ )"
,q "Q20" "\n\
\ select\n\
\ s_name,\n\
\ s_address\n\
@ -605,8 +604,8 @@ tpchQueries =
\ and s_nationkey = n_nationkey\n\
\ and n_name = 'VIETNAM'\n\
\ order by\n\
\ s_name")
,("Q21","\n\
\ s_name"
,q "Q21" "\n\
\ select\n\
\ s_name,\n\
\ count(*) as numwait\n\
@ -646,8 +645,8 @@ tpchQueries =
\ order by\n\
\ numwait desc,\n\
\ s_name\n\
\ fetch first 100 rows only")
,("Q22","\n\
\ fetch first 100 rows only"
,q "Q22" "\n\
\ select\n\
\ cntrycode,\n\
\ count(*) as numcust,\n\
@ -684,5 +683,8 @@ tpchQueries =
\ group by\n\
\ cntrycode\n\
\ order by\n\
\ cntrycode")
\ cntrycode"
]
where
q :: HasCallStack => Text -> Text -> TestItem
q _ src = testParseQueryExpr ansi2011 src