9fd2970f26
fix so following a number with either . or e or E without whitespace will cause a lexing error remove */ from symbols in postgres (although postgres strictly speaking allows this I think, it is not a good idea) reject */ anywhere with an error reject ||| (or more pipes) in ansi, etc. dialects instead of trying to parse it as something like '||', '|'
161 lines
5.5 KiB
Plaintext
161 lines
5.5 KiB
Plaintext
|
|
This is the main tests module which exposes the test data plus the
|
|
Test.Framework tests. It also contains the code which converts the
|
|
test data to the Test.Framework tests.
|
|
|
|
> module Language.SQL.SimpleSQL.Tests
|
|
> (testData
|
|
> ,tests
|
|
> ,TestItem(..)
|
|
> ) where
|
|
|
|
> import qualified Test.Tasty as T
|
|
> import qualified Test.Tasty.HUnit as H
|
|
|
|
> --import Language.SQL.SimpleSQL.Syntax
|
|
> import Language.SQL.SimpleSQL.Pretty
|
|
> import Language.SQL.SimpleSQL.Parse
|
|
> import Language.SQL.SimpleSQL.Lex
|
|
|
|
> import Language.SQL.SimpleSQL.TestTypes
|
|
|
|
> import Language.SQL.SimpleSQL.FullQueries
|
|
> import Language.SQL.SimpleSQL.GroupBy
|
|
> import Language.SQL.SimpleSQL.Postgres
|
|
> import Language.SQL.SimpleSQL.QueryExprComponents
|
|
> import Language.SQL.SimpleSQL.QueryExprs
|
|
> import Language.SQL.SimpleSQL.TableRefs
|
|
> import Language.SQL.SimpleSQL.ValueExprs
|
|
> import Language.SQL.SimpleSQL.Tpch
|
|
> import Language.SQL.SimpleSQL.LexerTests
|
|
|
|
> import Language.SQL.SimpleSQL.SQL2011Queries
|
|
> import Language.SQL.SimpleSQL.SQL2011AccessControl
|
|
> import Language.SQL.SimpleSQL.SQL2011Bits
|
|
> import Language.SQL.SimpleSQL.SQL2011DataManipulation
|
|
> import Language.SQL.SimpleSQL.SQL2011Schema
|
|
|
|
> import Language.SQL.SimpleSQL.MySQL
|
|
|
|
Order the tests to start from the simplest first. This is also the
|
|
order on the generated documentation.
|
|
|
|
> testData :: TestItem
|
|
> testData =
|
|
> Group "parserTest"
|
|
> [lexerTests
|
|
> ,valueExprTests
|
|
> ,queryExprComponentTests
|
|
> ,queryExprsTests
|
|
> ,tableRefTests
|
|
> ,groupByTests
|
|
> ,fullQueriesTests
|
|
> ,postgresTests
|
|
> ,tpchTests
|
|
> ,sql2011QueryTests
|
|
> ,sql2011DataManipulationTests
|
|
> ,sql2011SchemaTests
|
|
> ,sql2011AccessControlTests
|
|
> ,sql2011BitsTests
|
|
> ,mySQLTests
|
|
> ]
|
|
|
|
> tests :: T.TestTree
|
|
> tests = itemToTest testData
|
|
|
|
> --runTests :: IO ()
|
|
> --runTests = void $ H.runTestTT $ itemToTest testData
|
|
|
|
> itemToTest :: TestItem -> T.TestTree
|
|
> itemToTest (Group nm ts) =
|
|
> T.testGroup nm $ map itemToTest ts
|
|
> itemToTest (TestValueExpr d str expected) =
|
|
> toTest parseValueExpr prettyValueExpr 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 (ParseValueExprFails d str) =
|
|
> toFTest parseValueExpr prettyValueExpr d str
|
|
|
|
> itemToTest (LexTest d s ts) = makeLexerTest d s ts
|
|
> itemToTest (LexFails d s) = makeLexingFailsTest d s
|
|
|
|
> makeLexerTest :: Dialect -> String -> [Token] -> T.TestTree
|
|
> makeLexerTest d s ts = H.testCase s $ do
|
|
> let lx = either (error . show) id $ lexSQL d "" Nothing s
|
|
> H.assertEqual "" ts $ map snd lx
|
|
> let s' = prettyTokens d $ map snd lx
|
|
> H.assertEqual "pretty print" s s'
|
|
|
|
> makeLexingFailsTest :: Dialect -> String -> T.TestTree
|
|
> makeLexingFailsTest d s = H.testCase s $ do
|
|
> case lexSQL d "" Nothing s of
|
|
> Right x -> H.assertFailure $ "lexing should have failed: " ++ s ++ "\ngot: " ++ show x
|
|
> Left _ -> return ()
|
|
|
|
|
|
> toTest :: (Eq a, Show a) =>
|
|
> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
|
> -> (Dialect -> a -> String)
|
|
> -> Dialect
|
|
> -> String
|
|
> -> a
|
|
> -> T.TestTree
|
|
> toTest parser pp d str expected = H.testCase str $ do
|
|
> let egot = parser d "" Nothing str
|
|
> case egot of
|
|
> Left e -> H.assertFailure $ peFormattedError e
|
|
> Right got -> do
|
|
> H.assertEqual "" expected got
|
|
> let str' = pp d got
|
|
> let egot' = parser d "" Nothing str'
|
|
> case egot' of
|
|
> Left e' -> H.assertFailure $ "pp roundtrip"
|
|
> ++ "\n" ++ str'
|
|
> ++ peFormattedError e'
|
|
> Right got' -> H.assertEqual
|
|
> ("pp roundtrip" ++ "\n" ++ str')
|
|
> expected got'
|
|
|
|
> toPTest :: (Eq a, Show a) =>
|
|
> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
|
> -> (Dialect -> a -> String)
|
|
> -> Dialect
|
|
> -> String
|
|
> -> T.TestTree
|
|
> toPTest parser pp d str = H.testCase str $ do
|
|
> let egot = parser d "" Nothing str
|
|
> case egot of
|
|
> Left e -> H.assertFailure $ peFormattedError 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" ++ str' ++ "\n"
|
|
> ++ peFormattedError e'
|
|
> Right _got' -> return ()
|
|
|
|
|
|
> toFTest :: (Eq a, Show a) =>
|
|
> (Dialect -> String -> Maybe (Int,Int) -> String -> Either ParseError a)
|
|
> -> (Dialect -> a -> String)
|
|
> -> Dialect
|
|
> -> String
|
|
> -> T.TestTree
|
|
> toFTest parser _pp d str = H.testCase 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" ++ str
|