hssqlppp-0.2.0: Database/HsSqlPpp/Tests/LocalBindingsTests.lhs
Copyright 2010 Jake Wheat
Tests for the local bindings lookup code, which is a bit convoluted in
places, particularly for joins
> module Database.HsSqlPpp.Tests.LocalBindingsTests (localBindingsTests) where
> import Test.HUnit
> import Test.Framework
> import Test.Framework.Providers.HUnit
> --import Text.Show.Pretty
> --import Debug.Trace
> import Database.HsSqlPpp.AstInternals.TypeChecking.LocalBindings
> import Database.HsSqlPpp.Ast.SqlTypes
> --import Database.HsSqlPpp.Ast.Annotation
> --import Database.HsSqlPpp.Parsing.Parser
> --import Database.HsSqlPpp.Ast.TypeChecker
> --import Database.HsSqlPpp.Ast.Catalog
> data Item = Group String [Item]
> | Lookup [([LocalBindingsUpdate]
> ,String -- correlation name
> ,String -- id name
> ,Either [TypeError] (String,String,String,Type))] -- source, corr, type
> | StarExpand [([LocalBindingsUpdate], String, Either [TypeError] [(String,String,String,Type)])]
> localBindingsTests :: [Test.Framework.Test]
> localBindingsTests = itemToTft testData
test plan:
no updates uncor lookup, star
cor lookup,star
1 update
uncor match, match sys, no match, star (with sys not appearing)
cor same "
join update: join col type tests + incompatible
join on system columns
ambiguous ids
do cor tests with both cors
2 updates: just one pair: lookup in head with shadowing
lookup in tail
no match
use difference cor to get to shadowed in tail
case insensitive tests
expand composite tests
n layers of joins with ids from each layer cor and uncor, plus star expands
> testData :: Item
> testData =
> Group "local bindings tests" [ Lookup [
> testUnRec [] "" "test"
> ,testUnRec [] "test" "test"
> ,testRec [LBQualifiedIds "source1"
> ""
> [("test1", typeInt)
> ,("test2", typeBool)]
> []]
> ("source1","","test1",typeInt)
> ,testRec [unquids1] res11
> ,testRec [unquids1] res12
> ,testRec [unquids1] res13
> ,testRec [unquids1] res14
> ,testUnRec [unquids1] "" "asdasd"
> ,testRec [quids1] res21
> ,testRec [quids1] res22
> ,testRec [quids1] res23
> ,testRec [quids1] res24
> ,testUnRec [quids1] "qid1" "asdasd"
> ,testUnRec [quids1] "" "asdasd"
> ,testRec [quids2] res31
> ,testRec [quids2] res32
> ,testRec [quids2] res33
> ,testRec [quids2] res34
> ,testUnRec [quids2] "qid2" "asdasd"
> ,testUnRec [quids2] "" "asdasd"
> ,testRecNoCor [quids2] res31
> ,testRecNoCor [quids2] res32
> ,testRecNoCor [quids2] res33
> ,testRecNoCor [quids2] res34
> ]
> ,StarExpand [
> testStar [unquids1] "" $ Right [res11,res12]
> ,testStar [unquids1] "test" $ Left [UnrecognisedCorrelationName "test"]
> ,testStar [quids1] "" $ Right [res21,res22]
> ,testStar [quids1] "test2" $ Left [UnrecognisedCorrelationName "test2"]
> ,testStar [quids2] "" $ Right [res31,res32]
> ,testStar [quids2] "qid2" $ Right [res31,res32]
> ,testStar [quids2] "qid3" $ Left [UnrecognisedCorrelationName "qid3"]
> ]]
> where
> unquids1 = LBUnqualifiedIds "unqid1s"
> [("test1", typeInt)
> ,("test2", typeBool)]
> [("inttest1", typeInt)
> ,("inttest2", typeBool)]
> res11 = ("unqid1s","","test1",typeInt)
> res12 = ("unqid1s","","test2",typeBool)
> res13 = ("unqid1s","","inttest1",typeInt)
> res14 = ("unqid1s","","inttest2",typeBool)
> unquids2 = LBUnqualifiedIds "unqid2s"
> [("test1", ScalarType "text")
> ,("test3", ScalarType "int2")]
> [("inttest1", ScalarType "text")
> ,("inttest3", ScalarType "int2")]
> res211 = ("unqid2s","","test1",ScalarType "text")
> res212 = ("unqid2s","","test3",ScalarType "int2")
> res213 = ("unqid2s","","inttest1",ScalarType "text")
> res214 = ("unqid2s","","inttest3",ScalarType "int2")
> quids1 = LBQualifiedIds "qid1s"
> ""
> [("test1", typeInt)
> ,("test2", typeBool)]
> [("inttest1", typeInt)
> ,("inttest2", typeBool)]
> res21 = ("qid1s","","test1",typeInt)
> res22 = ("qid1s","","test2",typeBool)
> res23 = ("qid1s","","inttest1",typeInt)
> res24 = ("qid1s","","inttest2",typeBool)
> quids2 = LBQualifiedIds "qid2s"
> "qid2"
> [("test3", typeInt)
> ,("test4", typeBool)]
> [("inttest3", typeInt)
> ,("inttest4", typeBool)]
> res31 = ("qid2s","qid2","test3",typeInt)
> res32 = ("qid2s","qid2","test4",typeBool)
> res33 = ("qid2s","qid2","inttest3",typeInt)
> res34 = ("qid2s","qid2","inttest4",typeBool)
> testUnRec :: [LocalBindingsUpdate] -> String -> String
> -> ([LocalBindingsUpdate]
> ,String -- correlation name
> ,String -- id name
> ,Either [TypeError] (String,String,String,Type))
> testUnRec lbus cor i = (lbus,cor,i
> , Left [UnrecognisedIdentifier $
> if cor == "" then i else cor ++ "." ++ i])
> testRec :: [LocalBindingsUpdate]
> -> (String,String,String,Type)
> -> ([LocalBindingsUpdate]
> ,String -- correlation name
> ,String -- id name
> ,Either [TypeError] (String,String,String,Type))
> testRec lbus (src,cor,i,ty) = (lbus,cor,i,Right (src,cor,i,ty))
> testRecNoCor :: [LocalBindingsUpdate]
> -> (String,String,String,Type)
> -> ([LocalBindingsUpdate]
> ,String -- correlation name
> ,String -- id name
> ,Either [TypeError] (String,String,String,Type))
> testRecNoCor lbus (src,cor,i,ty) = (lbus,"",i,Right (src,cor,i,ty))
> testStar :: [LocalBindingsUpdate]
> -> String
> -> Either [TypeError] [(String,String,String,Type)]
> -> ([LocalBindingsUpdate]
> ,String -- correlation name
> ,Either [TypeError] [(String,String,String,Type)])
> testStar lbus cor res = (lbus,cor,res)
LBQualifiedIds {
source :: String
,correlationName :: String
,ids :: [(String,Type)]
,internalIds :: [(String,Type)]
}
| LBUnqualifiedIds {
source :: String
,ids :: [(String,Type)]
,internalIds :: [(String,Type)]
}
| LBJoinIds {
source1 :: String
,correlationName1 :: String
,ids1 :: [(String,Type)]
,internalIds1 :: [(String,Type)]
,source2 :: String
,correlationName2 :: String
,ids2 :: [(String,Type)]
,internalIds2 :: [(String,Type)]
,joinIds :: [String]
}
================================================================================
> testIdLookup :: [LocalBindingsUpdate]
> -> String
> -> String
> -> Either [TypeError] (String,String,String,Type)
> -> Test.Framework.Test
> testIdLookup lbus cn i res = testCase ("lookup " ++ cn ++ "." ++ i) $ do
> let lb = foldr lbUpdate emptyBindings lbus
> r = lbLookupID lb cn i
> assertEqual "lookupid" res r
> testStarExpand :: [LocalBindingsUpdate]
> -> String
> -> Either [TypeError] [(String,String,String,Type)]
> -> Test.Framework.Test
> testStarExpand lbus cn res = testCase ("expand star " ++ cn) $ do
> let lb = foldr lbUpdate emptyBindings lbus
> r = lbExpandStar lb cn
> assertEqual "lookupid" res r
> itemToTft :: Item -> [Test.Framework.Test]
> itemToTft (Lookup es) = map (\(a,b,c,d) -> testIdLookup a b c d) es
> itemToTft (StarExpand es) = map (\(a,b,c) -> testStarExpand a b c) es
> itemToTft (Group s is) = [testGroup s $ concatMap itemToTft is]