-------------------------------------------------------------------------------- -- See end of this file for licence information. -------------------------------------------------------------------------------- -- | -- Module : GraphTest -- Copyright : (c) 2003, Graham Klyne, 2009 Vasili I Galchin, 2011, 2012 Douglas Burke -- License : GPL V2 -- -- Maintainer : Douglas Burke -- Stability : experimental -- Portability : H98 -- -- This module defines test cases for module Graph. -- -------------------------------------------------------------------------------- module Main where import qualified Data.Foldable as F import Test.HUnit ( Test(TestCase,TestList,TestLabel), assertEqual, assertBool ) import Swish.GraphClass (Arc(..), ArcSet, LDGraph(..), Label(..)) import Swish.GraphClass (arc, arcFromTriple, arcToTriple) import Swish.GraphMem import Swish.GraphMatch ( LabelMap, GenLabelMap(..), EquivalenceClass, ScopedLabel(..), makeScopedLabel, makeScopedArc, LabelIndex, nullLabelVal, emptyMap, mapLabelIndex, {-mapLabelList,-} setLabelHash, newLabelMap, graphLabels, assignLabelMap, newGenerationMap -- graphMatch1 only used with pairSort , equivalenceClasses ) -- import Swish.Utils.ListHelpers (subset) import TestHelpers (runTestSuite, testEq, testNe) import Data.Function (on) import Data.Hashable (combine) import Data.List (sort, sortBy, elemIndex) import Data.Maybe (fromJust) import Data.Ord (comparing) import Data.Word (Word32) import qualified Data.Map as M import qualified Data.Set as S default ( Int ) ------------------------------------------------------------ -- Define some common values ------------------------------------------------------------ type Statement = Arc LabelMem base1, base2, base3, base4 :: String base1 = "http://id.ninebynine.org/wip/2003/test/graph1/node#" base2 = "http://id.ninebynine.org/wip/2003/test/graph2/node/" base3 = "http://id.ninebynine.org/wip/2003/test/graph3/node" base4 = "http://id.ninebynine.org/wip/2003/test/graph3/nodebase" ------------------------------------------------------------ -- Set, get graph arcs as sets of triples ------------------------------------------------------------ setArcsT :: (Ord lb, LDGraph lg lb) => S.Set (lb, lb, lb) -> lg lb -> lg lb setArcsT a g = setArcs g $ S.map arcFromTriple a getArcsT :: (Ord lb, LDGraph lg lb) => lg lb -> S.Set (lb, lb, lb) getArcsT g = S.map arcToTriple $ getArcs g ------------------------------------------------------------ -- Label map and entry creation helpers ------------------------------------------------------------ tstLabelMap :: (Label lb) => Word32 -> [(lb,LabelIndex)] -> LabelMap lb tstLabelMap gen = LabelMap gen . M.fromList ------------------------------------------------------------ -- Graph helper function tests ------------------------------------------------------------ {- -- select; no longer exported so need to check that -- other tests still test this routine testSelect :: String -> String -> String -> Test testSelect lab = testEq ("Select"++lab ) isOne :: Int -> Bool isOne = (1 ==) testSelect01, testSelect02, testSelect03, testSelect04 :: Test testSelect01 = testSelect "01" (select isOne [0,1,2,0,1,2] "abcabc") "bb" testSelect02 = testSelect "02" (select isOne [1,1,1,1,1,1] "abcabc") "abcabc" testSelect03 = testSelect "03" (select isOne [0,0,0,0,0,0] "abcabc") [] testSelect04 = testSelect "04" (select isOne [] [] ) [] testSelectSuite :: Test testSelectSuite = TestList [ testSelect01, testSelect02, testSelect03, testSelect04 ] -} -- subset: hopefully can remove soon {- testSubset :: String -> Bool -> [Int] -> [Int] -> Test testSubset lab res l1s l2s = testEq ("Mapset"++lab ) res (l1s `subset` l2s) testSubsetSuite :: Test testSubsetSuite = TestList [ testSubset "01" True [1,2,3] [0,1,2,3,4,5] , testSubset "02" True [5,3,1] [0,1,2,3,4,5] , testSubset "03" True [5,4,3,2,1,0] [0,1,2,3,4,5] , testSubset "04" True [] [] , testSubset "05" False [0,1,2,3,4,5] [1,2,3] , testSubset "06" False [0,1,2,3,4,5] [5,3,1] , testSubset "07" True [] [1,2,3] , testSubset "08" False [1,2,3] [] ] -} ------------------------------------------------------------ -- Simple graph label tests ------------------------------------------------------------ testLabSuite :: Test testLabSuite = TestList [ testEq "Lab01" False (labelIsVar lab1f) , testEq "Lab02" True (labelIsVar lab1v) , testEq "Lab03" False (labelIsVar lab2f) , testEq "Lab04" True (labelIsVar lab2v) {- This just tests the hash routine, which doesn't really tell us that much, so replace by checks that the hashes aren't the same , testEq "Lab05" 39495998 (labelHash 1 lab1f) , testEq "Lab06" 45349309 (labelHash 1 lab1v) , testEq "Lab07" 39495997 (labelHash 1 lab2f) , testEq "Lab08" 45349310 (labelHash 1 lab2v) -} , testNe "Hash Lab05/6" (labelHash 1 lab1f) (labelHash 1 lab1v) , testNe "Hash Lab05/7" (labelHash 1 lab1f) (labelHash 1 lab2f) , testNe "Hash Lab06/8" (labelHash 1 lab1v) (labelHash 1 lab2v) , testNe "Hash Lab07/8" (labelHash 1 lab2f) (labelHash 1 lab2v) , testNe "Hash Lab05/8" (labelHash 1 lab1f) (labelHash 1 lab2v) , testNe "Hash Lab06/7" (labelHash 1 lab1v) (labelHash 1 lab2f) , testEq "Lab09" "!lab1" (show lab1f) , testEq "Lab10" "?lab1" (show lab1v) , testEq "Lab11" "!lab2" (show lab2f) , testEq "Lab12" "?lab2" (show lab2v) , testEq "Lab13" "lab1" (getLocal lab1v) , testEq "Lab14" "lab2" (getLocal lab2v) , testEq "Lab15" lab1v (makeLabel "lab1") , testEq "Lab16" lab2v (makeLabel "lab2") ] ------------------------------------------------------------ -- Simple graph tests ------------------------------------------------------------ lab1f, lab1v, lab2f, lab2v :: LabelMem lab1f = LF "lab1" lab1v = LV "lab1" lab2f = LF "lab2" lab2v = LV "lab2" ga1 :: S.Set (LabelMem, LabelMem, LabelMem) ga1 = S.fromList [ (lab1f,lab1f,lab1f), (lab1v,lab1v,lab1v), (lab2f,lab2f,lab2f), (lab2v,lab2v,lab2v), (lab1f,lab1f,lab1v), (lab1f,lab1f,lab2f), (lab1f,lab1f,lab2v), (lab1v,lab1v,lab1f), (lab1v,lab1v,lab2f), (lab1v,lab1v,lab2v), (lab1f,lab1v,lab2f), (lab1f,lab1v,lab2v), (lab1v,lab2f,lab2v) ] gs4 :: Statement -> Bool gs4 (Arc _ _ (LV "lab2")) = True gs4 _ = False ga4 :: S.Set (LabelMem, LabelMem, LabelMem) ga4 = S.fromList [ (lab2v,lab2v,lab2v), (lab1f,lab1f,lab2v), (lab1v,lab1v,lab2v), (lab1f,lab1v,lab2v), (lab1v,lab2f,lab2v) ] ga2 :: S.Set (LabelMem, LabelMem, LabelMem) ga2 = S.fromList [ (lab1f,lab1f,lab1f), (lab1v,lab1v,lab1v), (lab2f,lab2f,lab2f), (lab2v,lab2v,lab2v) ] ga3 :: S.Set (LabelMem, LabelMem, LabelMem) ga3 = S.fromList [ (lab1f,lab1f,lab1v), (lab1f,lab1f,lab2f), (lab1f,lab1f,lab2v), (lab1v,lab1v,lab1f), (lab1v,lab1v,lab2f), (lab1v,lab1v,lab2v), (lab1f,lab1v,lab2f), (lab1f,lab1v,lab2v), (lab1v,lab2f,lab2v) ] gl4 :: S.Set LabelMem gl4 = S.fromList [lab1f,lab1v,lab2f,lab2v] gr1a, gr2a, gr3a, gr4a, gr4b, gr4c, gr4d, gr4e, gr4g :: GraphMem LabelMem gr1a = setArcsT ga1 (GraphMem S.empty) gr2a = setArcsT ga2 emptyGraph gr3a = setArcsT ga3 emptyGraph gr4a = addGraphs gr2a gr3a gr4b = addGraphs gr3a gr2a gr4c = delete gr2a gr4a gr4d = delete gr3a gr4a gr4e = extract gs4 gr4a gr4g = addGraphs gr2a gr4a gl4f :: S.Set LabelMem gl4f = labels gr4a {- gr4ee :: [Bool] gr4ee = map gs4 $ S.toList (getArcs gr4a) -} testGraphSuite :: Test testGraphSuite = TestList [ testEq "Graph01" ga1 (getArcsT gr1a) , testEq "Graph01" ga2 (getArcsT gr2a) , testEq "Graph03" ga3 (getArcsT gr3a) , testEq "Graph04" ga1 (getArcsT gr4a) , testEq "Graph05" ga1 (getArcsT gr4b) , testEq "Graph06" ga3 (getArcsT gr4c) , testEq "Graph07" ga2 (getArcsT gr4d) , testEq "Graph08" ga4 (getArcsT gr4e) , testEq "Graph09" gl4 gl4f , testEq "Graph10" ga1 (getArcsT gr4g) ] ------------------------------------------------------------ -- ------------------------------------------------------------ ------------------------------------------------------------ -- Define some common values ------------------------------------------------------------ s1, s2, s3, s4, s5, s6, s7, s8 :: LabelMem s1 = LF "s1" s2 = LF "s2" s3 = LF "s3" s4 = LF "" s5 = LV "s5" s6 = LF "basemore" s7 = LF ("base"++"more") s8 = LV "s8" b1, b2, b3, b4 :: LabelMem b1 = LV "b1" b2 = LV "b2" b3 = LV "b3" b4 = LV "b4" p1, p2, p3, p4 :: LabelMem p1 = LF "p1" p2 = LF "p2" p3 = LF "p3" p4 = LF "p4" o1, o2, o3, o4, o5, o6 :: LabelMem o1 = LF "o1" o2 = LF "o2" o3 = LF "o3" o4 = LF "" o5 = LV "o5" o6 = LV "s5" l1, l2, l3, l4, l5, l6, l7, l8, l9, l10, l11, l12 :: LabelMem l1 = LF "l1" l2 = LF "l2-en" l3 = LF "l2-fr" l4 = LF "l4-type1" l5 = LF "l4-type1" l6 = LF "l4-type1" l7 = LF "l4-type2" l8 = LF "l4-type2" l9 = LF "l4-type2" l10 = LF "l10-xml" l11 = LF "l10-xml-en" l12 = LF "l10-xml-fr" v1, v2, v3, v4 :: LabelMem v1 = LV "v1" v2 = LV "v2" v3 = LV "v3" v4 = LV "v4" ------------------------------------------------------------ -- Label construction and equality tests ------------------------------------------------------------ testLabelEq :: String -> Bool -> LabelMem -> LabelMem -> Test testLabelEq lab eq n1 n2 = TestCase ( assertEqual ("testLabelEq:"++lab) eq (n1==n2) ) nodelist :: [(String, LabelMem)] nodelist = [ ("s1",s1), ("s2",s2), ("s3",s3), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7), ("s8",s8), ("o5",o5), ("p1",p1), ("p2",p2), ("p3",p3), ("p4",p4), ("o1",o1), ("o2",o2), ("o3",o3), ("o4",o4), ("l1",l1), ("l2",l2), ("l3",l3), ("l4",l4), ("l5",l5), ("l6",l6), ("l7",l7), ("l8",l8), ("l9",l9), ("l10",l10), ("l11",l11), ("l12",l12), ("v1",v1), ("v2",v2) ] nodeeqlist :: [(String, String)] nodeeqlist = [ ("s4","o4"), ("s5","o6"), ("s6","s7"), ("l4","l5"), ("l4","l6"), ("l5","l6"), ("l7","l8"), ("l7","l9"), ("l8","l9") ] testLabelEqSuite :: Test testLabelEqSuite = TestList [ testLabelEq (testLab a b) (nodeTest a b) n1 n2 | (a,n1) <- nodelist , (b,n2) <- nodelist ] where testLab a b = a ++ "-" ++ b nodeTest a b = (a == b) || (a,b) `elem` nodeeqlist || (b,a) `elem` nodeeqlist ------------------------------------------------------------ -- Label ordering tests ------------------------------------------------------------ testLabelOrd :: String -> Ordering -> LabelMem -> LabelMem -> Test testLabelOrd lab order n1 n2 = TestCase ( assertEqual ("testLabelOrd:"++lab) order (compare n1 n2) ) nodeorder :: [String] nodeorder = [ "o4", "s4", "s6", "s7", "l1", "l10", "l11", "l12", "l2", "l3", "l4", "l5", "l6", "l7", "l8", "l9", "o1", "o2", "o3", "p1", "p2", "p3", "p4", "s1", "s2", "s3", "b1", "b2", "b3", "b4", "o5", "s5", "s8", "v1", "v2" ] testLabelOrdSuite :: Test testLabelOrdSuite = TestList [ testLabelOrd (testLab a b) (testOrd a b) n1 n2 | (a,n1) <- nodelist , (b,n2) <- nodelist ] where testLab a b = a ++ "-" ++ b testOrd a b | nodeTest a b = EQ | otherwise = comparing fromJust (elemIndex a nodeorder) (elemIndex b nodeorder) nodeTest a b = (a == b) || (a,b) `elem` nodeeqlist || (b,a) `elem` nodeeqlist ------------------------------------------------------------ -- Statement construction and equality tests ------------------------------------------------------------ testStmtEq :: String -> Bool -> Statement -> Statement -> Test testStmtEq lab eq t1 t2 = TestCase ( assertEqual ("testStmtEq:"++lab) eq (t1==t2) ) -- String argument is no longer needed, due to refactoring of -- tlist, but left in -- slist :: [(String, LabelMem)] slist = [ ("s1",s1), ("s4",s4), ("s5",s5), ("s6",s6), ("s7",s7) ] plist :: [(String, LabelMem)] plist = [ ("p1",p1) ] olist :: [(String, LabelMem)] olist = [ ("o1",o1), ("o4",o4), ("o5",o5), ("l1",l1), ("l4",l4), ("l7",l7), ("l8",l8), ("l10",l10) ] tlist :: [(String, Statement)] tlist = [ t s p o | (_,s) <- slist, (_,p) <- plist, (_,o) <- olist ] where t s p o = let a = Arc s p o in (show a, a) stmteqlist :: [(String, String)] stmteqlist = [ ("(s6,p1,l1)", "(s7,p1,l1)"), ("(s6,p1,l4)", "(s7,p1,l4)"), ("(s6,p1,l7)", "(s7,p1,l7)"), ("(s6,p1,l7)", "(s7,p1,l8)"), ("(s6,p1,l8)", "(s7,p1,l7)"), ("(s6,p1,l8)", "(s7,p1,l8)"), ("(s6,p1,l10)","(s7,p1,l10)"), ("(s6,p1,o1)", "(s7,p1,o1)"), ("(s6,p1,o4)", "(s7,p1,o4)"), ("(s6,p1,o5)", "(s7,p1,o5)"), ("(s1,p1,l7)", "(s1,p1,l8)"), ("(s4,p1,l7)", "(s4,p1,l8)"), ("(s5,p1,l7)", "(s5,p1,l8)"), ("(s6,p1,l7)", "(s6,p1,l8)"), ("(s7,p1,l7)", "(s7,p1,l8)") ] testStmtEqSuite :: Test testStmtEqSuite = TestList [ testStmtEq (testLab a b) (nodeTest a b) t1 t2 | (a,t1) <- tlist , (b,t2) <- tlist ] where testLab a b = a ++ "-" ++ b nodeTest a b = (a == b) || (a,b) `elem` stmteqlist || (b,a) `elem` stmteqlist ------------------------------------------------------------ -- Graph element handling support routines ------------------------------------------------------------ lmap :: LabelMap LabelMem lmap = tstLabelMap 5 [(s1,(1,1)),(s2,(2,2)),(s3,(3,3)),(s4,(4,4)), (o1,(1,1)),(o2,(2,2)),(o3,(3,3))] -- setLabelHash :: (Label lb) => LabelMap lb -> (lb,Int) -> LabelMap lb lmap1, lmap2a, lmap2b, lmap3 :: LabelMap LabelMem lmap1 = setLabelHash lmap (s2,22) lmap2a = setLabelHash lmap1 (o1,66) lmap2b = setLabelHash lmap2a (o5,67) -- newLabelMap :: (Label lb) => LabelMap lb -> [(lb,Int)] -> LabelMap lb lmap3 = newLabelMap lmap [(s1,61),(s3,63),(o2,66)] llst :: [String] llst = ["s1","s2","s3","s4","o1","o2","o3"] -- showLabelMap :: (Label lb) => LabelMap lb -> String testShowLabelMap :: Test testShowLabelMap = testEq "showLabelMap" showMap (show lmap) where showMap = "LabelMap gen=5, map=\n"++ " (!,(4,4))\n"++ " (!o1,(1,1))\n"++ " (!o2,(2,2))\n"++ " (!o3,(3,3))\n"++ " (!s1,(1,1))\n"++ " (!s2,(2,2))\n"++ " (!s3,(3,3))" testMapLabelHash00 :: Test testMapLabelHash00 = testEq "mapLabelHash00" showMap (show lmap1) where showMap = "LabelMap gen=5, map=\n"++ " (!,(4,4))\n"++ " (!o1,(1,1))\n"++ " (!o2,(2,2))\n"++ " (!o3,(3,3))\n"++ " (!s1,(1,1))\n"++ " (!s2,(5,22))\n"++ " (!s3,(3,3))" -- mapLabelIndex :: (Label lb) => LabelMap lb -> lb -> LabelIndex testLabelMapSuite :: Test testLabelMapSuite = TestList [ testShowLabelMap , testMapLabelHash00 , testEq "testMapLabelIndex01" (1,1) (mapLabelIndex lmap s1 ) , testEq "testMapLabelIndex02" (2,2) (mapLabelIndex lmap s2 ) , testEq "testMapLabelIndex03" (3,3) (mapLabelIndex lmap s3 ) , testEq "testMapLabelIndex04" (4,4) (mapLabelIndex lmap s4 ) , testEq "testMapLabelIndex05" (1,1) (mapLabelIndex lmap o1 ) , testEq "testMapLabelIndex06" (4,4) (mapLabelIndex lmap o4 ) , testEq "testMapLabelIndex07" nullLabelVal (mapLabelIndex lmap o5 ) , testEq "testMapLabelIndex08" nullLabelVal (mapLabelIndex lmap o6 ) , testEq "MapLabelHash01" (1,1) (mapLabelIndex lmap1 s1 ) , testEq "MapLabelHash02" (5,22) (mapLabelIndex lmap1 s2 ) , testEq "MapLabelHash03" (3,3) (mapLabelIndex lmap1 s3 ) , testEq "MapLabelHash04" (4,4) (mapLabelIndex lmap1 s4 ) , testEq "MapLabelHash05" (1,1) (mapLabelIndex lmap1 o1 ) , testEq "MapLabelHash06" (4,4) (mapLabelIndex lmap1 o4 ) , testEq "MapLabelHash07" nullLabelVal (mapLabelIndex lmap1 o5 ) , testEq "MapLabelHash08" nullLabelVal (mapLabelIndex lmap1 o6 ) , testEq "MapLabelHash11" (1,1) (mapLabelIndex lmap2b s1 ) , testEq "MapLabelHash12" (5,22) (mapLabelIndex lmap2b s2 ) , testEq "MapLabelHash13" (3,3) (mapLabelIndex lmap2b s3 ) , testEq "MapLabelHash14" (4,4) (mapLabelIndex lmap2b s4 ) , testEq "MapLabelHash15" (5,66) (mapLabelIndex lmap2b o1 ) , testEq "MapLabelHash16" (2,2) (mapLabelIndex lmap2b o2 ) , testEq "MapLabelHash17" (4,4) (mapLabelIndex lmap2b o4 ) , testEq "MapLabelHash18" nullLabelVal (mapLabelIndex lmap1 o5 ) , testEq "LabelMap01" (6,61) (mapLabelIndex lmap3 s1 ) , testEq "LabelMap02" (2,2) (mapLabelIndex lmap3 s2 ) , testEq "LabelMap03" (6,63) (mapLabelIndex lmap3 s3 ) , testEq "LabelMap04" (4,4) (mapLabelIndex lmap3 s4 ) , testEq "LabelMap05" (1,1) (mapLabelIndex lmap3 o1 ) , testEq "LabelMap06" (6,66) (mapLabelIndex lmap3 o2 ) ] ------------------------------------------------------------ -- Graph matching support ------------------------------------------------------------ t01, t02, t03, t04, t05, t06 :: Statement t01 = arc s1 p1 o1 t02 = arc s2 p1 o2 t03 = arc s3 p1 o3 t04 = arc s1 p1 l1 t05 = arc s2 p1 l4 t06 = arc s3 p1 l10 tOrder16 :: [Statement] tOrder16 = [t04, t01, t05, t02, t06, t03] t10, t11, t12 :: Statement t10 = arc s1 p1 b1 t11 = arc b1 p2 b2 t12 = arc b2 p3 o1 t20, t21, t22 :: Statement t20 = arc s1 p1 b3 t21 = arc b3 p2 b4 t22 = arc b4 p3 o1 as1, as2, as4, as5, as6 :: S.Set Statement as1 = S.singleton t01 as2 = S.fromList [t01,t02,t03,t04,t05,t06] as4 = S.fromList [t01,t02,t03,t04,t05,t06,t10,t11,t12] as5 = S.fromList [t01,t02,t03,t04,t05,t06,t20,t21,t22] as6 = S.fromList [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22] -- graphLabels :: (Label lb) => ArcSet lb -> S.Set lb -- not clear both the 'raw' and 'string' versions are still needed. ls4, glas4 :: S.Set LabelMem ls4 = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2] glas4 = graphLabels as4 testGraphLabels04, testGraphLabels14 :: Test testGraphLabels04 = testEq "GraphLabels04" ls4 glas4 testGraphLabels14 = testEq "GraphLabels14" str (show glas4) where -- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3]" str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b1,?b2]" -- str = show ls4 ls5, glas5 :: S.Set LabelMem ls5 = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b3,b4] glas5 = graphLabels as5 testGraphLabels05, testGraphLabels15 :: Test testGraphLabels05 = testEq "GraphLabels05" ls5 glas5 testGraphLabels15 = testEq "GraphLabels15" str (show glas5) where -- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3,!l1,!l4-type1,!l10-xml,?b3,!p2,?b4,!p3]" str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b3,?b4]" -- str = show ls5 ls6, glas6 :: S.Set LabelMem ls6 = S.fromList [s1,s2,s3,p1,p2,p3,o1,o2,o3,l1,l4,l10,b1,b2,b3,b4] glas6 = graphLabels as6 testGraphLabels06, testGraphLabels16 :: Test testGraphLabels06 = testEq "GraphLabels05" ls6 glas6 testGraphLabels16 = testEq "GraphLabels16" str (show glas6) where -- str = "[!s1,!p1,!o1,!s2,!o2,!s3,!o3"++ -- ",!l1,!l4-type1,!l10-xml,?b1,!p2,?b2,!p3,?b3,?b4]" str = "fromList [!l1,!l10-xml,!l4-type1,!o1,!o2,!o3,!p1,!p2,!p3,!s1,!s2,!s3,?b1,?b2,?b3,?b4]" -- str = show ls6 -- assignLabels :: (Label lb) => [lb] -> LabelMap lb -> LabelMap lb bhash :: Word32 bhash = 23 -- since the hashing is now done by hashable, is it worth checking -- the hash values directly? -- copy of internal code in GraphMatch toHash :: (Label lb) => Int -> lb -> Word32 toHash s lbl = fromIntegral $ if labelIsVar lbl then s `combine` 23 else labelHash s lbl l1hash, l4hash, l10hash :: Word32 l1hash = toHash 0 l1 l4hash = toHash 0 l4 l10hash = toHash 0 l10 l1hash2, l4hash2, l10hash2 :: Word32 l1hash2 = l1hash l4hash2 = l4hash l10hash2 = l10hash o1hash, o2hash, o3hash :: Word32 o1hash = toHash 0 o1 o2hash = toHash 0 o2 o3hash = toHash 0 o3 p1hash, p2hash, p3hash :: Word32 p1hash = toHash 0 p1 p2hash = toHash 0 p2 p3hash = toHash 0 p3 s1hash, s2hash, s3hash :: Word32 s1hash = toHash 0 s1 s2hash = toHash 0 s2 s3hash = toHash 0 s3 lmap5 :: LabelMap LabelMem lmap5 = tstLabelMap 2 [ (b4,(1,bhash)), (b3,(1,bhash)), (l10,(1,l10hash)), (l4,(1,l4hash)), (l1,(1,l1hash)), (o3,(1,o3hash)), (o2,(1,o2hash)), (o1,(1,o1hash)), (p3,(1,p3hash)), (p2,(1,p2hash)), (p1,(1,p1hash)), (s3,(1,s3hash)), (s2,(1,s2hash)), (s1,(1,s1hash)) ] testAssignLabelMap05 :: Test testAssignLabelMap05 = testEq "AssignLabels05" lmap5 (newGenerationMap $ assignLabelMap ls5 emptyMap) lmap6 :: LabelMap LabelMem lmap6 = tstLabelMap 2 [ (b2,(2,bhash)), (b1,(2,bhash)), (b4,(1,bhash)), (b3,(1,bhash)), (l10,(1,l10hash)), (l4,(1,l4hash)), (l1,(1,l1hash)), (o3,(1,o3hash)), (o2,(1,o2hash)), (o1,(1,o1hash)), (p3,(1,p3hash)), (p2,(1,p2hash)), (p1,(1,p1hash)), (s3,(1,s3hash)), (s2,(1,s2hash)), (s1,(1,s1hash)) ] testAssignLabelMap06 :: Test testAssignLabelMap06 = testEq "AssignLabels06" lmap6 (assignLabelMap ls6 lmap5) lmapc :: LabelMap LabelMem lmapc = tstLabelMap 1 [(s1,(1,11)),(s2,(1,12)),(s3,(1,13)), (p1,(1,21)),(p2,(1,22)),(p3,(1,13)), (o1,(1,31)),(o2,(1,32)),(o3,(1,13)), (l1,(1,41)),(l4,(1,42)),(l10,(1,43)), (b1,(1,51)),(b2,(1,51)),(b3,(1,51)),(b4,(1,51))] -- [[[TODO: test hash value collision on non-variable label]]] testGraphMatchSupportSuite :: Test testGraphMatchSupportSuite = TestList [ testGraphLabels04 , testGraphLabels14 , testGraphLabels05 , testGraphLabels15 , testGraphLabels06 , testGraphLabels16 , testAssignLabelMap05 , testAssignLabelMap06 -- implicitly tested elsewhere but included here for completeness , testEq "O16-identity" tOrder16 $ sort tOrder16 , testEq "O16-compare" tOrder16 $ sort [t01,t02,t03,t04,t05,t06] ] ------------------------------------------------------------ -- Test steps in graph equality test ------------------------------------------------------------ matchable :: a -> b -> Bool matchable _ _ = True s1_1, s2_1, s3_1 :: ScopedLabel LabelMem s1_1 = makeScopedLabel 1 s1 s2_1 = makeScopedLabel 1 s2 s3_1 = makeScopedLabel 1 s3 p1_1, p2_1, p3_1 :: ScopedLabel LabelMem p1_1 = makeScopedLabel 1 p1 p2_1 = makeScopedLabel 1 p2 p3_1 = makeScopedLabel 1 p3 o1_1, o2_1, o3_1 :: ScopedLabel LabelMem o1_1 = makeScopedLabel 1 o1 o2_1 = makeScopedLabel 1 o2 o3_1 = makeScopedLabel 1 o3 l1_1, l4_1, l10_1 :: ScopedLabel LabelMem l1_1 = makeScopedLabel 1 l1 l4_1 = makeScopedLabel 1 l4 l10_1 = makeScopedLabel 1 l10 b1_1, b2_1, b3_1, b4_1 :: ScopedLabel LabelMem b1_1 = makeScopedLabel 1 b1 b2_1 = makeScopedLabel 1 b2 b3_1 = makeScopedLabel 1 b3 b4_1 = makeScopedLabel 1 b4 s1_2, s2_2, s3_2 :: ScopedLabel LabelMem s1_2 = makeScopedLabel 2 s1 s2_2 = makeScopedLabel 2 s2 s3_2 = makeScopedLabel 2 s3 p1_2, p2_2, p3_2 :: ScopedLabel LabelMem p1_2 = makeScopedLabel 2 p1 p2_2 = makeScopedLabel 2 p2 p3_2 = makeScopedLabel 2 p3 o1_2, o2_2, o3_2 :: ScopedLabel LabelMem o1_2 = makeScopedLabel 2 o1 o2_2 = makeScopedLabel 2 o2 o3_2 = makeScopedLabel 2 o3 l1_2, l4_2, l10_2 :: ScopedLabel LabelMem l1_2 = makeScopedLabel 2 l1 l4_2 = makeScopedLabel 2 l4 l10_2 = makeScopedLabel 2 l10 b1_2, b2_2, b3_2, b4_2 :: ScopedLabel LabelMem b1_2 = makeScopedLabel 2 b1 b2_2 = makeScopedLabel 2 b2 b3_2 = makeScopedLabel 2 b3 b4_2 = makeScopedLabel 2 b4 t01_1 :: Arc (ScopedLabel LabelMem) t01_1 = makeScopedArc 1 t01 t01_2, t02_2, t03_2, t04_2, t05_2, t06_2 :: Arc (ScopedLabel LabelMem) t01_2 = makeScopedArc 2 t01 t02_2 = makeScopedArc 2 t02 t03_2 = makeScopedArc 2 t03 t04_2 = makeScopedArc 2 t04 t05_2 = makeScopedArc 2 t05 t06_2 = makeScopedArc 2 t06 t10_1, t11_1, t12_1, t20_1, t21_1, t22_1 :: Arc (ScopedLabel LabelMem) t10_1 = makeScopedArc 1 t10 t11_1 = makeScopedArc 1 t11 t12_1 = makeScopedArc 1 t12 t20_1 = makeScopedArc 1 t20 t21_1 = makeScopedArc 1 t21 t22_1 = makeScopedArc 1 t22 t10_2, t11_2, t12_2, t20_2, t21_2, t22_2 :: Arc (ScopedLabel LabelMem) t10_2 = makeScopedArc 2 t10 t11_2 = makeScopedArc 2 t11 t12_2 = makeScopedArc 2 t12 t20_2 = makeScopedArc 2 t20 t21_2 = makeScopedArc 2 t21 t22_2 = makeScopedArc 2 t22 -- Compare graph as6 with self, in steps as61, as62 :: ArcSet (ScopedLabel LabelMem) as61 = S.map (makeScopedArc 1) as6 as62 = S.map (makeScopedArc 2) as6 eq1lmap :: LabelMap (ScopedLabel LabelMem) eq1lmap = newGenerationMap $ assignLabelMap (graphLabels as62) $ assignLabelMap (graphLabels as61) emptyMap eq1ltst :: LabelMap (ScopedLabel LabelMem) eq1ltst = tstLabelMap 2 [ (b4_2,(1,bhash)), (b3_2,(1,bhash)), (p3_2,(1,p3hash)), (b2_2,(1,bhash)), (p2_2,(1,p2hash)), (b1_2,(1,bhash)), (l10_2,(1,l10hash)), (l4_2,(1,l4hash)), (l1_2,(1,l1hash)), (o3_2,(1,o3hash)), (s3_2,(1,s3hash)), (o2_2,(1,o2hash)), (s2_2,(1,s2hash)), (o1_2,(1,o1hash)), (p1_2,(1,p1hash)), (s1_2,(1,s1hash)), (b4_1,(1,bhash)), (b3_1,(1,bhash)), (p3_1,(1,p3hash)), (b2_1,(1,bhash)), (p2_1,(1,p2hash)), (b1_1,(1,bhash)), (l10_1,(1,l10hash)), (l4_1,(1,l4hash)), (l1_1,(1,l1hash)), (o3_1,(1,o3hash)), (s3_1,(1,s3hash)), (o2_1,(1,o2hash)), (s2_1,(1,s2hash)), (o1_1,(1,o1hash)), (p1_1,(1,p1hash)), (s1_1,(1,s1hash)) ] testEqAssignMap01 :: Test testEqAssignMap01 = testEq "EqAssignMap01" eq1ltst eq1lmap eq1hs1, eq1hs2 :: [Arc (ScopedLabel LabelMem)] eq1hs1 = [t10_1,t11_1,t12_1,t20_1,t21_1,t22_1] eq1hs2 = [t10_2,t11_2,t12_2,t20_2,t21_2,t22_2] eq1lmap' :: LabelMap (ScopedLabel LabelMem) eq1lmap' = tstLabelMap 2 [(s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)), (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)), (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)), (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)), (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)), (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)), (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)), (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)), (b1_1,(2,3880463)),(b2_1,(2,3400925)), (b3_1,(2,3880463)), (b4_1,(2,3400925)), (b1_2,(2,3880463)),(b2_2,(2,3400925)), (b3_2,(2,3880463)), (b4_2,(2,3400925))] eq1lmap'' :: LabelMap (ScopedLabel LabelMem) eq1lmap'' = newLabelMap eq1lmap' [ (b1_1,2576315),(b2_1,3400925),(b3_1,1571691), (b1_2,2576315),(b2_2,3400925),(b3_2,1571691) ] eq1ltst'' :: LabelMap (ScopedLabel LabelMem) eq1ltst'' = tstLabelMap 3 [ (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)), (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)), (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)), (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)), (b1_1,(3,2576315)), (b2_1,(3,3400925)), (b3_1,(3,1571691)), (b4_1,(2,3400925)), (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)), (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)), (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)), (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)), (b1_2,(3,2576315)), (b2_2,(3,3400925)), (b3_2,(3,1571691)), (b4_2,(2,3400925)) ] testEqNewLabelMap07 :: Test testEqNewLabelMap07 = testEq "EqNewLabelMap07" eq1ltst'' eq1lmap'' -- Repeat same tests for as4... as41, as42 :: ArcSet (ScopedLabel LabelMem) as41 = S.map (makeScopedArc 1) as4 as42 = S.map (makeScopedArc 2) as4 eq2lmap :: LabelMap (ScopedLabel LabelMem) eq2lmap = newGenerationMap $ assignLabelMap (graphLabels as42) $ assignLabelMap (graphLabels as41) emptyMap eq2ltst :: LabelMap (ScopedLabel LabelMem) eq2ltst = tstLabelMap 2 [ (p3_2,(1,p3hash)), (b2_2,(1,bhash)), (b1_2,(1,bhash)), (p2_2,(1,p2hash)), (l10_2,(1,l10hash)), (l4_2,(1,l4hash)), (l1_2,(1,l1hash)), (o3_2,(1,o3hash)), (s3_2,(1,s3hash)), (o2_2,(1,o2hash)), (s2_2,(1,s2hash)), (o1_2,(1,o1hash)), (p1_2,(1,p1hash)), (s1_2,(1,s1hash)), (p3_1,(1,p3hash)), (b2_1,(1,bhash)), (p2_1,(1,p2hash)), (b1_1,(1,bhash)), (l10_1,(1,l10hash)), (l4_1,(1,l4hash)), (l1_1,(1,l1hash)), (o3_1,(1,o3hash)), (s3_1,(1,s3hash)), (o2_1,(1,o2hash)), (s2_1,(1,s2hash)), (o1_1,(1,o1hash)), (p1_1,(1,p1hash)), (s1_1,(1,s1hash)) ] testEqAssignMap21 :: Test testEqAssignMap21 = testEq "EqAssignMap21" eq2ltst eq2lmap eq2hs1, eq2hs2 :: [Arc (ScopedLabel LabelMem)] eq2hs1 = [t10_1,t11_1,t12_1] eq2hs2 = [t10_2,t11_2,t12_2] eq2lmap' :: LabelMap (ScopedLabel LabelMem) eq2lmap' = tstLabelMap 2 [ (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)), (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)), (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)), (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)), (b1_1,(2,3880463)),(b2_1,(2,3400925)), (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)), (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)), (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)), (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)), (b1_2,(2,3880463)),(b2_2,(2,3400925)) ] eq2lmap'' :: LabelMap (ScopedLabel LabelMem) eq2lmap'' = newLabelMap eq2lmap' [ (b2_1,3400925), (b2_2,3400925) ] eq2ltst'' :: LabelMap (ScopedLabel LabelMem) eq2ltst'' = tstLabelMap 3 [ (s1_1,(1,142577)),(s2_1,(1,142578)),(s3_1,(1,142579)), (p1_1,(1,142385)),(p2_1,(1,142386)),(p3_1,(1,142387)), (o1_1,(1,142321)),(o2_1,(1,142322)),(o3_1,(1,142323)), (l1_1,(1,142129)),(l4_1,(1,1709580)),(l10_1,(1,3766582)), (b1_1,(2,3880463)), (b2_1,(3,3400925)), (s1_2,(1,142577)),(s2_2,(1,142578)),(s3_2,(1,142579)), (p1_2,(1,142385)),(p2_2,(1,142386)),(p3_2,(1,142387)), (o1_2,(1,142321)),(o2_2,(1,142322)),(o3_2,(1,142323)), (l1_2,(1,142129)),(l4_2,(1,1709580)),(l10_2,(1,3766582)), (b1_2,(2,3880463)), (b2_2,(3,3400925)) ] testEqNewLabelMap27 :: Test testEqNewLabelMap27 = testEq "EqNewLabelMap27" eq2ltst'' eq2lmap'' -- Compare as1 with as2, in steps as11, as22 :: ArcSet (ScopedLabel LabelMem) as11 = S.map (makeScopedArc 1) as1 as22 = S.map (makeScopedArc 2) as2 eq3hs1, eq3hs2 :: ArcSet (ScopedLabel LabelMem) eq3hs1 = S.singleton t01_1 eq3hs2 = S.fromList [t01_2,t02_2,t03_2,t04_2,t05_2,t06_2] testEqGraphMap31_1, testEqGraphMap31_2 :: Test testEqGraphMap31_1 = testEq "testEqGraphMap31_1" eq3hs1 as11 testEqGraphMap31_2 = testEq "testEqGraphMap31_2" eq3hs2 as22 eq3lmap :: LabelMap (ScopedLabel LabelMem) eq3lmap = newGenerationMap $ assignLabelMap (graphLabels as11) $ assignLabelMap (graphLabels as22) emptyMap eq3ltst :: LabelMap (ScopedLabel LabelMem) eq3ltst = tstLabelMap 2 [ (o1_1,(1,o1hash)) , (p1_1,(1,p1hash)) , (s1_1,(1,s1hash)) , (l10_2,(1,l10hash)) , (l4_2,(1,l4hash)) , (l1_2,(1,l1hash)) , (o3_2,(1,o3hash)) , (s3_2,(1,s3hash)) , (o2_2,(1,o2hash)) , (s2_2,(1,s2hash)) , (o1_2,(1,o1hash)) , (p1_2,(1,p1hash)) , (s1_2,(1,s1hash)) ] testEqAssignMap32 :: Test testEqAssignMap32 = testEq "EqAssignMap32" eq3ltst eq3lmap type EquivClass = EquivalenceClass (ScopedLabel LabelMem) type EquivArgs = ((Word32, Word32), [ScopedLabel LabelMem]) ec31 :: [EquivClass] ec31 = equivalenceClasses eq3lmap (graphLabels as11) ec31test :: [EquivArgs] ec31test = sortBy (compare `on` (snd.fst)) [ ((1,o1hash),[o1_1]) , ((1,p1hash),[p1_1]) , ((1,s1hash),[s1_1]) ] ec32 :: [EquivClass] ec32 = equivalenceClasses eq3lmap (graphLabels as22) ec32test :: [EquivArgs] ec32test = sortBy (compare `on` (snd.fst)) [ ((1,l1hash),[l1_2]) , ((1,o2hash),[o2_2]) , ((1,o3hash),[o3_2]) , ((1,o1hash),[o1_2]) , ((1,p1hash),[p1_2]) , ((1,s2hash),[s2_2]) , ((1,s3hash),[s3_2]) , ((1,s1hash),[s1_2]) , ((1,l10hash),[l10_2]) , ((1,l4hash),[l4_2]) ] testEquivClass33_1, testEquivClass33_2 :: Test testEquivClass33_1 = testEq "EquivClass33_1" ec31test ec31 testEquivClass33_2 = testEq "EquivClass33_2" ec32test ec32 {- as pairSOrt is no-longer exported need to check this code gets tested -- This value is nonsense for this test, -- but a parameter is needed for graphMatch1 (below) ec3pairs :: [(EquivClass, EquivClass)] ec3pairs = zip (pairSort ec31) (pairSort ec32) -} {- This is a pointless test in this case ec3test :: [(EquivClass, EquivClass)] ec3test = [ ( ((1,142321),[o1_1]), ((1,142321),[o1_2]) ) , ( ((1,142385),[p1_1]), ((1,142385),[p1_2]) ) , ( ((1,142577),[s1_1]), ((1,142577),[s1_2]) ) ] testEquivClass33_3 = testEq "EquivClass33_3" ec3test ec3pairs -} {- pairSort is no longer exported eq3lmap1 :: (Bool, LabelMap (ScopedLabel LabelMem)) eq3lmap1 = graphMatch1 False matchable eq3hs1 eq3hs2 eq3lmap ec3pairs -} eq3ltst1 :: LabelMap (ScopedLabel LabelMem) eq3ltst1 = tstLabelMap 2 [ (o1_1,(1,142321)) , (p1_1,(1,142385)) , (s1_1,(1,142577)) , (l10_2,(1,3766582)) , (l4_2,(1,1709580)) , (l1_2,(1,142129)) , (o3_2,(1,142323)) , (s3_2,(1,142579)) , (o2_2,(1,142322)) , (s2_2,(1,142578)) , (o1_2,(1,142321)) , (p1_2,(1,142385)) , (s1_2,(1,142577)) ] -- testEqAssignMap34 = testEq "EqAssignMap34" (Just eq3ltst1) eq3lmap1 -- testEqAssignMap34 = testEq "EqAssignMap34" Nothing eq3lmap1 {- pairSort is not exported testEqAssignMap34 :: Test testEqAssignMap34 = testEq "EqAssignMap34" False (fst eq3lmap1) -} {- eq3rc1 = reclassify eq3hs1 eq3lmap eq3rctst1 = [] testEqReclassify35_1 = testEqv "EqReclassify35_1" (makeEntries eq3rctst1) eq3rc1 eq3rc2 = reclassify eq3hs2 eq3lmap eq3rctst2 = [] testEqReclassify35_2 = testEqv "EqReclassify35_2" (makeEntries eq3rctst2) eq3rc2 -} -- Test suite testGraphMatchStepSuite :: Test testGraphMatchStepSuite = TestList [ testEqAssignMap01 -- , testEqReclassify03_1, testEqReclassify03_2 , testEqNewLabelMap07 -- , testEqGraphMatch08 , testEqAssignMap21 -- , testEqReclassify23_1, testEqReclassify23_2 , testEqNewLabelMap27 -- , testEqGraphMatch28 , testEqGraphMap31_1, testEqGraphMap31_2 , testEqAssignMap32 , testEquivClass33_1, testEquivClass33_2 -- , testEquivClass33_3 -- , testEqAssignMap34 pairSort is not exported -- , testEqReclassify35_1, testEqReclassify35_2 ] ------------------------------------------------------------ -- Graph equality tests ------------------------------------------------------------ testGraphEq :: ( Label lb ) => String -> Bool -> GraphMem lb -> GraphMem lb -> Test testGraphEq lab eq gg1 gg2 = TestCase ( assertEqual ("testGraphEq:"++lab) eq (gg1==gg2) ) toG :: [Statement] -> GraphMem LabelMem toG stmts = GraphMem { arcs = S.fromList stmts } g1, g2, g3, g4, g5, g6, g7, g8 :: GraphMem LabelMem g1 = toG [t01] g2 = toG [t01,t02,t03,t04,t05,t06] g3 = toG [t06,t05,t04,t03,t02,t01] g4 = toG [t01,t02,t03,t04,t05,t06,t10,t11,t12] g5 = toG [t01,t02,t03,t04,t05,t06,t20,t21,t22] g6 = toG [t01,t02,t03,t04,t05,t06,t10,t11,t12,t20,t21,t22] g7 = toG [t01,t02] g8 = toG [t02,t01] glist :: [(String, GraphMem LabelMem)] glist = [ ("g1",g1), ("g2",g2), ("g3",g3), ("g4",g4), ("g5",g5), ("g6",g6) ] grapheqlist :: [(String, String)] grapheqlist = [ ("g2","g3") , ("g4","g5") ] testGraphEqSuitePart :: Test testGraphEqSuitePart = TestLabel "testGraphEqSuitePart" $ TestList [ testGraphEq "g1-g2" False g1 g2 , testGraphEq "g2-g1" False g2 g1 , testGraphEq "g2-g2" True g2 g2 , testGraphEq "g2-g3" True g2 g3 , testGraphEq "g1-g4" False g1 g4 , testGraphEq "g2-g4" False g2 g4 , testGraphEq "g3-g4" False g3 g4 , testGraphEq "g4-g3" False g4 g3 , testGraphEq "g4-g4" True g4 g4 , testGraphEq "g4-g5" True g4 g5 , testGraphEq "g4-g6" False g4 g6 , testGraphEq "g6-g6" True g6 g6 , testGraphEq "g7-g7" True g7 g7 , testGraphEq "g7-g8" True g7 g8 , testGraphEq "g8-g7" True g8 g7 ] testGraphEqSuite :: Test testGraphEqSuite = TestLabel "testGraphEqSuite" $ TestList [ testGraphEq (testLab ll1 ll2) (nodeTest ll1 ll2) gg1 gg2 | (ll1,gg1) <- glist , (ll2,gg2) <- glist ] where testLab ll1 ll2 = ll1 ++ "-" ++ ll2 nodeTest ll1 ll2 = (ll1 == ll2) || (ll1,ll2) `elem` grapheqlist || (ll2,ll1) `elem` grapheqlist -- Selected tests for debugging geq12, geq21, geq22, geq23, geq14, geq24, geq77, geq78, geq87 :: Test geq12 = testGraphEq "g1-g2" False g1 g2 geq21 = testGraphEq "g2-g1" False g2 g1 geq22 = testGraphEq "g2-g2" True g2 g2 geq23 = testGraphEq "g2-g3" True g2 g3 geq14 = testGraphEq "g1-g4" False g1 g4 geq24 = testGraphEq "g2-g4" False g2 g4 geq77 = testGraphEq "g7-g7" True g7 g7 geq78 = testGraphEq "g7-g8" True g7 g8 geq87 = testGraphEq "g8-g7" True g8 g7 ------------------------------------------------------------ -- More graph equality tests ------------------------------------------------------------ -- -- These tests are based on the 10-node, triply connected -- graph examples in Jeremy Carroll's paper on matching RDF -- graphs. -- Graph pattern 1: -- pentangle-in-pentangle, corresponding vertices linked upward v101, v102, v103, v104, v105, v106, v107, v108, v109, v110 :: LabelMem v101 = LV "v101" v102 = LV "v102" v103 = LV "v103" v104 = LV "v104" v105 = LV "v105" v106 = LV "v106" v107 = LV "v107" v108 = LV "v108" v109 = LV "v109" v110 = LV "v110" p101, p102, p103, p104, p105, p106, p107, p108, p109, p110, p111, p112, p113, p114, p115 :: LabelMem p101 = LV "p101" p102 = LV "p102" p103 = LV "p103" p104 = LV "p104" p105 = LV "p105" p106 = LV "p106" p107 = LV "p107" p108 = LV "p108" p109 = LV "p109" p110 = LV "p110" p111 = LV "p111" p112 = LV "p112" p113 = LV "p113" p114 = LV "p114" p115 = LV "p115" t10102, t10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 :: Statement t10102 = arc v101 p101 v102 t10203 = arc v102 p102 v103 t10304 = arc v103 p103 v104 t10405 = arc v104 p104 v105 t10501 = arc v105 p105 v101 t10106 = arc v101 p106 v106 t10207 = arc v102 p107 v107 t10308 = arc v103 p108 v108 t10409 = arc v104 p109 v109 t10510 = arc v105 p110 v110 t10607 = arc v106 p111 v107 t10708 = arc v107 p112 v108 t10809 = arc v108 p113 v109 t10910 = arc v109 p114 v110 t11006 = arc v110 p115 v106 -- Graph pattern 2: -- pentangle-in-pentangle, corresponding vertices linked downward v201, v202, v203, v204, v205, v206, v207, v208, v209, v210 :: LabelMem v201 = LV "v201" v202 = LV "v202" v203 = LV "v203" v204 = LV "v204" v205 = LV "v205" v206 = LV "v206" v207 = LV "v207" v208 = LV "v208" v209 = LV "v209" v210 = LV "v210" p201, p202, p203, p204, p205, p206, p207, p208, p209, p210, p211, p212, p213, p214, p215 :: LabelMem p201 = LV "p201" p202 = LV "p202" p203 = LV "p203" p204 = LV "p204" p205 = LV "p205" p206 = LV "p206" p207 = LV "p207" p208 = LV "p208" p209 = LV "p209" p210 = LV "p210" p211 = LV "p211" p212 = LV "p212" p213 = LV "p213" p214 = LV "p214" p215 = LV "p215" t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t21005, t20607, t20708, t20809, t20910, t21006 :: Statement t20102 = arc v201 p201 v202 t20203 = arc v202 p202 v203 t20304 = arc v203 p203 v204 t20405 = arc v204 p204 v205 t20501 = arc v205 p205 v201 t20601 = arc v206 p206 v201 t20702 = arc v207 p207 v202 t20803 = arc v208 p208 v203 t20904 = arc v209 p209 v204 t21005 = arc v210 p210 v205 t20607 = arc v206 p211 v207 t20708 = arc v207 p212 v208 t20809 = arc v208 p213 v209 t20910 = arc v209 p214 v210 t21006 = arc v210 p215 v206 -- Graph pattern 3: -- star-in-pentangle, corresponding vertices linked toward star -- Although this graph is similarly linked to patterns 1 and 2, -- it is topologically different as it contains circuits only of -- length 5, where the others have circuits of length 4 and 5 -- (ignoring direction of arcs) v301, v302, v303, v304, v305, v306, v307, v308, v309, v310 :: LabelMem v301 = LV "v301" v302 = LV "v302" v303 = LV "v303" v304 = LV "v304" v305 = LV "v305" v306 = LV "v306" v307 = LV "v307" v308 = LV "v308" v309 = LV "v309" v310 = LV "v310" p301, p302, p303, p304, p305, p306, p307, p308, p309, p310, p311, p312, p313, p314, p315 :: LabelMem p301 = LV "p301" p302 = LV "p302" p303 = LV "p303" p304 = LV "p304" p305 = LV "p305" p306 = LV "p306" p307 = LV "p307" p308 = LV "p308" p309 = LV "p309" p310 = LV "p310" p311 = LV "p311" p312 = LV "p312" p313 = LV "p313" p314 = LV "p314" p315 = LV "p315" t30102, t30203, t30304, t30405, t30501, t30106, t30207, t30308, t30409, t30510, t30608, t30709, t30810, t30906, t31007 :: Statement t30102 = arc v301 p301 v302 t30203 = arc v302 p302 v303 t30304 = arc v303 p303 v304 t30405 = arc v304 p304 v305 t30501 = arc v305 p305 v301 t30106 = arc v301 p306 v306 t30207 = arc v302 p307 v307 t30308 = arc v303 p308 v308 t30409 = arc v304 p309 v309 t30510 = arc v305 p310 v310 t30608 = arc v306 p311 v308 t30709 = arc v307 p312 v309 t30810 = arc v308 p313 v310 t30906 = arc v309 p314 v306 t31007 = arc v310 p315 v307 -- Graph pattern 4: -- pentangle-in-pentangle, corresponding vertices linked upward -- The vertices 6-10 are linked in reverse order to the -- corresponding vertices 1-5. v401, v402, v403, v404, v405, v406, v407, v408, v409, v410 :: LabelMem v401 = LV "v401" v402 = LV "v402" v403 = LV "v403" v404 = LV "v404" v405 = LV "v405" v406 = LV "v406" v407 = LV "v407" v408 = LV "v408" v409 = LV "v409" v410 = LV "v410" p401, p402, p403, p404, p405, p406, p407, p408, p409, p410, p411, p412, p413, p414, p415 :: LabelMem p401 = LV "p401" p402 = LV "p402" p403 = LV "p403" p404 = LV "p404" p405 = LV "p405" p406 = LV "p406" p407 = LV "p407" p408 = LV "p408" p409 = LV "p409" p410 = LV "p410" p411 = LV "p411" p412 = LV "p412" p413 = LV "p413" p414 = LV "p414" p415 = LV "p415" t40102, t40203, t40304, t40405, t40501, t40106, t40207, t40308, t40409, t40510, t41009, t40908, t40807, t40706, t40610:: Statement t40102 = arc v401 p401 v402 t40203 = arc v402 p402 v403 t40304 = arc v403 p403 v404 t40405 = arc v404 p404 v405 t40501 = arc v405 p405 v401 t40106 = arc v401 p406 v406 t40207 = arc v402 p407 v407 t40308 = arc v403 p408 v408 t40409 = arc v404 p409 v409 t40510 = arc v405 p410 v410 t41009 = arc v410 p411 v409 t40908 = arc v409 p412 v408 t40807 = arc v408 p413 v407 t40706 = arc v407 p414 v406 t40610 = arc v406 p415 v410 -- Graph pattern 5: -- Same as pattern 1, except same fixed property in all cases. p5 :: LabelMem p5 = LF "p5" t50102, t50203, t50304, t50405, t50501, t50106, t50207, t50308, t50409, t50510, t50607, t50708, t50809, t50910, t51006 :: Statement t50102 = arc v101 p5 v102 t50203 = arc v102 p5 v103 t50304 = arc v103 p5 v104 t50405 = arc v104 p5 v105 t50501 = arc v105 p5 v101 t50106 = arc v101 p5 v106 t50207 = arc v102 p5 v107 t50308 = arc v103 p5 v108 t50409 = arc v104 p5 v109 t50510 = arc v105 p5 v110 t50607 = arc v106 p5 v107 t50708 = arc v107 p5 v108 t50809 = arc v108 p5 v109 t50910 = arc v109 p5 v110 t51006 = arc v110 p5 v106 -- Graph pattern 6: -- Same as pattern 5, with different variables t60102, t60203, t60304, t60405, t60501, t60106, t60207, t60308, t60409, t60510, t60607, t60708, t60809, t60910, t61006 :: Statement t60102 = arc v201 p5 v202 t60203 = arc v202 p5 v203 t60304 = arc v203 p5 v204 t60405 = arc v204 p5 v205 t60501 = arc v205 p5 v201 t60106 = arc v201 p5 v206 t60207 = arc v202 p5 v207 t60308 = arc v203 p5 v208 t60409 = arc v204 p5 v209 t60510 = arc v205 p5 v210 t60607 = arc v206 p5 v207 t60708 = arc v207 p5 v208 t60809 = arc v208 p5 v209 t60910 = arc v209 p5 v210 t61006 = arc v210 p5 v206 -- arcsToGraph :: (Ord a) => [Arc a] -> GraphMem a arcsToGraph as = GraphMem { arcs = S.fromList as } -- Very simple case g100 :: GraphMem LabelMem g100 = arcsToGraph [ t10102, t10203, t10304, t10405, t10501, t10607, t10708, t10809, t10910, t11006 ] g200 :: GraphMem LabelMem g200 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20607, t20708, t20809, t20910, t21006 ] -- 10/3 node graph comparisons g101 :: GraphMem LabelMem g101 = arcsToGraph [ t10102, t10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g201 :: GraphMem LabelMem g201 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t21005, t20607, t20708, t20809, t20910, t21006 ] g301 :: GraphMem LabelMem g301 = arcsToGraph [ t30102, t30203, t30304, t30405, t30501, t30106, t30207, t30308, t30409, t30510, t30608, t30709, t30810, t30906, t31007 ] g401 :: GraphMem LabelMem g401 = arcsToGraph [ t40102, t40203, t40304, t40405, t40501, t40106, t40207, t40308, t40409, t40510, t40610, t40706, t40807, t40908, t41009 ] g501 :: GraphMem LabelMem g501 = arcsToGraph [ t50102, t50203, t50304, t50405, t50501, t50106, t50207, t50308, t50409, t50510, t50607, t50708, t50809, t50910, t51006 ] g601 :: GraphMem LabelMem g601 = arcsToGraph [ t60102, t60203, t60304, t60405, t60501, t60106, t60207, t60308, t60409, t60510, t60607, t60708, t60809, t60910, t61006 ] -- Remove one arc from each g102 :: GraphMem LabelMem g102 = arcsToGraph [ t10102, t10203, t10304, t10405, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g202 :: GraphMem LabelMem g202 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t21005, t20708, t20809, t20910, t21006 ] g302 :: GraphMem LabelMem g302 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t20607, t20708, t20809, t20910, t21006 ] -- Remove two adjacent arcs from each g103 :: GraphMem LabelMem g103 = arcsToGraph [ t10102, t10203, t10304, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g203 :: GraphMem LabelMem g203 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t21005, t20607, t20708, t21006 ] g303 :: GraphMem LabelMem g303 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20904, t20607, t20708, t20809, t21006 ] -- Remove two adjacent arcs from one, non-adjacent from another g104 :: GraphMem LabelMem g104 = arcsToGraph [ t10102, t10203, t10304, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g204 :: GraphMem LabelMem g204 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20601, t20702, t20803, t20607, t20708, t20809, t20910, t21006 ] -- Compare two rings of 5 with one ring of 10 -- (each node double-connected, but different overall topology) t10901 :: Statement t10901 = arc v109 p109 v101 g105 :: GraphMem LabelMem g105 = arcsToGraph [ t10102, t10203, t10304, t10405, t10901, t10510, t10607, t10708, t10809, t11006 ] g205 :: GraphMem LabelMem g205 = arcsToGraph [ t20102, t20203, t20304, t20405, t20501, t20607, t20708, t20809, t20910, t21006 ] -- Reverse one arc from test 01 -- (also, rearrange arcs to catch ordering artefacts) t20201 :: Statement t20201 = arc v202 p201 v201 g106 :: GraphMem LabelMem g106 = arcsToGraph [ t10102, t10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g206 :: GraphMem LabelMem g206 = arcsToGraph [ t20607, t20708, t20809, t20910, t21006, t20601, t20702, t20803, t20904, t21005, t20102, t20203, t20304, t20405, t20501 ] g306 :: GraphMem LabelMem g306 = arcsToGraph [ t20607, t20708, t20809, t20910, t21006, t20601, t20702, t20803, t20904, t21005, t20201, t20203, t20304, t20405, t20501 ] -- Similar tests to 02,03,04, -- but add identified property rather than removing arcs f01, f02 :: LabelMem f01 = LF "f01" f02 = LF "f02" -- Fix one arc from each f10102, f10501, f21006, f20510 :: Statement f10102 = arc v101 f01 v102 f10501 = arc v105 f01 v101 f21006 = arc v210 f01 v206 f20510 = arc v205 f01 v210 g107 :: GraphMem LabelMem g107 = arcsToGraph [ f10102, t10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g207 :: GraphMem LabelMem g207 = arcsToGraph [ t10102, t10203, t10304, t10405, f10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g307 :: GraphMem LabelMem g307 = arcsToGraph [ t20607, t20708, t20809, t20910, f21006, t20601, t20702, t20803, t20904, t21005, t20102, t20203, t20304, t20405, t20501 ] g407 :: GraphMem LabelMem g407 = arcsToGraph [ t20607, t20708, t20809, t20910, t21006, t20601, t20702, t20803, t20904, t21005, t20102, t20203, t20304, t20405, t20501 ] -- Fix two adjacent arcs from each f10203, f10405, f20910, f20601 :: Statement f10203 = arc v102 f01 v103 f10405 = arc v104 f01 v105 f20910 = arc v209 f01 v210 f20601 = arc v206 f01 v201 g108 :: GraphMem LabelMem g108 = arcsToGraph [ f10102, f10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g208 :: GraphMem LabelMem g208 = arcsToGraph [ t10102, t10203, t10304, f10405, f10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g308 :: GraphMem LabelMem g308 = arcsToGraph [ t20607, t20708, t20809, f20910, f21006, t20601, t20702, t20803, t20904, t21005, t20102, t20203, t20304, t20405, t20501 ] g408 :: GraphMem LabelMem g408 = arcsToGraph [ t20607, t20708, t20809, t20910, f21006, f20601, t20702, t20803, t20904, t21005, t20102, t20203, t20304, t20405, t20501 ] -- Fix two adjacent arcs with different properties g10203, g10102, g10405 :: Statement g10203 = arc v102 f02 v103 g10102 = arc v101 f02 v102 g10405 = arc v104 f02 v105 g109, g209, g309 :: GraphMem LabelMem g109 = arcsToGraph [ f10102, g10203, t10304, t10405, t10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g209 = arcsToGraph [ g10102, t10203, t10304, t10405, f10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] g309 = arcsToGraph [ t10102, t10203, t10304, g10405, f10501, t10106, t10207, t10308, t10409, t10510, t10607, t10708, t10809, t10910, t11006 ] mgeq00 :: Test mgeq00 = testGraphEq "g100-g200" True g100 g200 mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156 :: Test mgeq0112 = testGraphEq "g101-g201" True g101 g201 mgeq0113 = testGraphEq "g101-g301" False g101 g301 mgeq0114 = testGraphEq "g101-g401" False g101 g401 mgeq0115 = testGraphEq "g101-g501" False g101 g501 mgeq0116 = testGraphEq "g101-g601" False g101 g601 mgeq0156 = testGraphEq "g501-g601" True g501 g601 mgeq0212, mgeq0213 :: Test mgeq0212 = testGraphEq "g102-g202" True g102 g202 mgeq0213 = testGraphEq "g102-g302" False g102 g302 mgeq0312, mgeq0313 :: Test mgeq0312 = testGraphEq "g103-g203" True g103 g203 mgeq0313 = testGraphEq "g103-g303" False g103 g303 mgeq04, mgeq05 :: Test mgeq04 = testGraphEq "g104-g204" False g104 g204 mgeq05 = testGraphEq "g105-g205" False g105 g205 mgeq0612, mgeq0613 :: Test mgeq0612 = testGraphEq "g106-g206" True g106 g206 mgeq0613 = testGraphEq "g106-g306" False g106 g306 mgeq0712, mgeq0713, mgeq0714 :: Test mgeq0712 = testGraphEq "g107-g207" True g107 g207 mgeq0713 = testGraphEq "g107-g307" True g107 g307 mgeq0714 = testGraphEq "g107-g407" False g107 g407 mgeq0812, mgeq0813, mgeq0814 :: Test mgeq0812 = testGraphEq "g108-g208" True g108 g208 mgeq0813 = testGraphEq "g108-g308" True g108 g308 mgeq0814 = testGraphEq "g108-g408" False g108 g408 mgeq0912, mgeq0913 :: Test mgeq0912 = testGraphEq "g109-g209" True g109 g209 mgeq0913 = testGraphEq "g109-g309" False g109 g309 testGraphEqSuiteMore :: Test testGraphEqSuiteMore = TestList [ mgeq00 , mgeq0112, mgeq0113, mgeq0114, mgeq0115, mgeq0116, mgeq0156 , mgeq0212, mgeq0213 , mgeq0312, mgeq0313 , mgeq04 , mgeq05 , mgeq0612, mgeq0613 , mgeq0712, mgeq0713, mgeq0714 , mgeq0812, mgeq0813, mgeq0814 , mgeq0912, mgeq0913 ] ------------------------------------------------------------ -- All tests ------------------------------------------------------------ allTests :: Test allTests = TestList [ -- testSelectSuite -- testSubsetSuite testLabSuite , testGraphSuite , testLabelEqSuite , testLabelOrdSuite , TestCase (assertBool "arc neq" (Arc True True True /= Arc True True False)) -- silly test of Eq instance , testStmtEqSuite , testLabelMapSuite , testGraphMatchSupportSuite , testGraphMatchStepSuite , testGraphEqSuitePart , testGraphEqSuite , testGraphEqSuiteMore -- test of Foldable instance of Arc , TestCase (assertEqual "fold Arc" [1::Int,2,4] (F.fold (Arc [1::Int] [2] [4]))) ] main :: IO () main = runTestSuite allTests {- runTestFile t = do h <- openFile "a.tmp" WriteMode runTestText (putTextToHandle h False) t hClose h tf = runTestFile tt = runTestTT geq = testGraphEqSuite geq1 = testGraphEqSuiteMore ttmore = tt testGraphEqSuiteMore -- this test may take a long time tfmore = tf testGraphEqSuiteMore ttstep = tt testGraphMatchStepSuite tfstep = tf testGraphMatchStepSuite -} -------------------------------------------------------------------------------- -- -- Copyright (c) 2003, Graham Klyne, 2009 Vasili I Galchin, -- 2011, 2012 Douglas Burke -- All rights reserved. -- -- This file is part of Swish. -- -- Swish is free software; you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- Swish is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with Swish; if not, write to: -- The Free Software Foundation, Inc., -- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -- --------------------------------------------------------------------------------