From 91875b7e7efc556635b0d828f245e19720829f04 Mon Sep 17 00:00:00 2001
From: Jake Wheat <jakewheatmail@gmail.com>
Date: Sat, 15 Aug 2015 19:04:29 +0300
Subject: [PATCH] rearrange tests slightly and hide/show tests in the website a
bit better
---
tools/Language/SQL/SimpleSQL/LexerTests.lhs | 8 +++---
.../Language/SQL/SimpleSQL/SQL2011Queries.lhs | 25 ++++++++++++-------
website/RenderTestCases.lhs | 12 +++------
3 files changed, 25 insertions(+), 20 deletions(-)
diff --git a/tools/Language/SQL/SimpleSQL/LexerTests.lhs b/tools/Language/SQL/SimpleSQL/LexerTests.lhs
index 41e5a1c..c97187b 100644
--- a/tools/Language/SQL/SimpleSQL/LexerTests.lhs
+++ b/tools/Language/SQL/SimpleSQL/LexerTests.lhs
@@ -57,8 +57,8 @@ Test for the lexer
> lexerTests :: TestItem
> lexerTests = Group "lexerTests" $
-> [LexerTest SQL2011 s t | (s,t) <- lexerTable]
-> ++
+> [Group "lexer token tests" $ [LexerTest SQL2011 s t | (s,t) <- lexerTable]
+> ,Group "generated combination lexer tests" $
> [ LexerTest SQL2011 (s ++ s1) (t ++ t1)
> | (s,t) <- lexerTable
> , (s1,t1) <- lexerTable
@@ -74,10 +74,12 @@ number number (todo: double check more carefully)
> , isGood $ t ++ t1
> ]
-> ++ map (uncurry $ LexerTest SQL2011)
+> ,Group "adhoc lexer tests" $
+> map (uncurry $ LexerTest SQL2011)
> [("", [])
> ,("-- line com\nstuff", [LineComment "-- line com\n",Identifier "stuff"])
> ]
+> ]
> where
> isGood :: [Token] -> Bool
diff --git a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs
index d3c59e9..ce22edb 100644
--- a/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs
+++ b/tools/Language/SQL/SimpleSQL/SQL2011Queries.lhs
@@ -1024,11 +1024,10 @@ new multipliers
create a list of type name variations:
-> typeNames :: [(String,TypeName)]
+> typeNames :: ([(String,TypeName)],[(String,TypeName)])
> typeNames =
-> basicTypes
-> ++ concatMap makeArray basicTypes
-> ++ map makeMultiset basicTypes
+> (basicTypes, concatMap makeArray basicTypes
+> ++ map makeMultiset basicTypes)
> where
> makeArray (s,t) = [(s ++ " array", ArrayTypeName t Nothing)
> ,(s ++ " array[5]", ArrayTypeName t (Just 5))]
@@ -1188,13 +1187,21 @@ Now test each variation in both cast expression and typed literal
expression
> typeNameTests :: TestItem
-> typeNameTests = Group "type names" $ map (uncurry (TestValueExpr SQL2011))
-> $ concatMap makeTests typeNames
+> typeNameTests = Group "type names"
+> [Group "type names" $ map (uncurry (TestValueExpr SQL2011))
+> $ concatMap makeSimpleTests $ fst typeNames
+> ,Group "generated casts" $ map (uncurry (TestValueExpr SQL2011))
+> $ concatMap makeCastTests $ fst typeNames
+> ,Group "generated typename" $ map (uncurry (TestValueExpr SQL2011))
+> $ concatMap makeTests $ snd typeNames]
> where
-> makeTests (ctn, stn) =
-> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "test") stn)
-> ,(ctn ++ " 'test'", TypedLit stn "test")
+> makeSimpleTests (ctn, stn) =
+> [(ctn ++ " 'test'", TypedLit stn "test")
> ]
+> makeCastTests (ctn, stn) =
+> [("cast('test' as " ++ ctn ++ ")", Cast (StringLit "test") stn)
+> ]
+> makeTests a = makeSimpleTests a ++ makeCastTests a
== 6.2 <field definition>
diff --git a/website/RenderTestCases.lhs b/website/RenderTestCases.lhs
index 6b2fba6..c535a6e 100644
--- a/website/RenderTestCases.lhs
+++ b/website/RenderTestCases.lhs
@@ -6,11 +6,14 @@ Converts the test data to asciidoc
> import Control.Monad.State
> import Language.SQL.SimpleSQL.Parser
> import Language.SQL.SimpleSQL.Lexer
+> import Data.List
> data TableItem = Heading Int String
> | Row String String
> doc :: Int -> TestItem -> [TableItem]
+> -- filter out some groups of tests
+> doc n (Group nm _) | "generated" `isInfixOf` nm = []
> doc n (Group nm is) =
> Heading n nm
> : concatMap (doc (n + 1)) is
@@ -30,14 +33,7 @@ Converts the test data to asciidoc
> [Row str (ppShow $ parseValueExpr d "" Nothing str)]
> doc _ (LexerTest d str t) =
-> -- todo: figure out how to handle this:
-> -- too many entries, but want to show the lexing
-> -- a bit
-> -- [Row str (ppShow $ lexSQL d "" Nothing str)]
-> []
-> -- should probably think about doing something similar
-> -- with other generated combination tests such as the typename
-> -- tests
+> [Row str (ppShow $ lexSQL d "" Nothing str)]
TODO: should put the dialect in the html output