1{-# LANGUAGE FlexibleContexts, ScopedTypeVariables #-}
2
3{- |
4   Module      : TestSuite
5   Description : fgl test suite
6   Copyright   : (c) Ivan Lazar Miljenovic
7   License     : BSD3
8   Maintainer  : Ivan.Miljenovic@gmail.com
9
10
11
12 -}
13module Main where
14
15import Data.Graph.Inductive.Arbitrary        ()
16import Data.Graph.Inductive.Graph
17import Data.Graph.Inductive.Graph.Properties
18import Data.Graph.Inductive.Proxy
19import Data.Graph.Inductive.Query.Properties
20
21import Test.Hspec
22import Test.Hspec.QuickCheck
23import Test.QuickCheck       (Arbitrary, Testable)
24
25-- -----------------------------------------------------------------------------
26
27main :: IO ()
28main = hspec $ do
29  graphTests "Tree Graphs"         (Proxy :: TreeP)
30  graphTests "PatriciaTree Graphs" (Proxy :: PatriciaTreeP)
31  queryTests
32  describe "Miscellaneous" $
33    prop "edge projections" (edge_projections :: LEdge Char -> Bool)
34
35-- -----------------------------------------------------------------------------
36
37-- | Run all available tests on the specified graph type.  Requires
38--   multiple edges and loops to be permissible.
39graphTests :: forall gr. (DynGraph gr, Eq (GraphType gr), Arbitrary (GraphType gr), Show (GraphType gr))
40               => String -> GraphProxy gr -> Spec
41graphTests nm p = describe nm $ do
42  describe "Static tests" $ do
43    propType  "Eq instance"     valid_Eq
44    propType  "node count"      valid_node_count
45    propType  "nodeRange"       valid_nodeRange
46    proxyProp "mkGraph (nodes)" valid_mkGraph_nodes
47    proxyProp "mkGraph (edges)" valid_mkGraph_edges
48    proxyProp "mkGraph (order)" valid_mkGraph_order
49    propType  "match"           valid_match
50    propType  "matchAny"        valid_matchAny
51    propType  "newNodes"        newNodes_really_new
52    propType  "ufold (nodes)"   ufold_all_nodes
53    propType  "gelem"           all_nodes_gelem
54    propType  "gelem vs nodes"  gelem_in_nodes
55    propType  "hasNeighborAdj"  valid_hasNeighborAdj
56    propType  "hasNeighbor"     valid_hasNeighbor
57    propType  "hasLEdge"        valid_hasLEdge
58
59  describe "Dynamic tests" $ do
60    propType  "merging (&)"       valid_merge
61    propType  "gmap (id)"         gmap_id
62    propType  "insNode"           valid_insNode
63    propType  "insNodes"          valid_insNodes
64    propType  "insEdge"           valid_insEdge
65    propType  "insEdges"          valid_insEdges
66    propType  "insEdges (mult)"   valid_insEdges_multiple
67    propType  "delNode"           valid_delNode
68    propType  "delNodes"          valid_delNodes
69    propType  "delEdge"           valid_delEdge
70    propType  "delEdges"          valid_delEdges
71    propType  "delLEdge"          valid_delLEdge
72    propType  "delAllLEdge"       valid_delAllLEdge
73    proxyProp "valid_mkGraph"     valid_mkGraph
74    propType  "valid_buildGr"     valid_buildGr
75    propType  "gfiltermap (id)"   gfiltermap_id
76    propType  "nfilter (true)"    nfilter_true
77    propType  "labnfilter (true)" labnfilter_true
78    propType  "labfilter (true)"  labfilter_true
79    propType  "subgraph"          valid_subgraph
80
81  where
82    proxyProp str = prop str . ($p)
83
84    propType :: (Testable pr) => String -> (GraphType gr -> pr) -> Spec
85    propType = prop
86
87-- -----------------------------------------------------------------------------
88
89-- | Run all available tests for query functions.  Only tested with
90--   one graph data structure, as it is assumed that any functions
91--   used by a query function are adequately tested with 'graphTests'.
92queryTests :: Spec
93queryTests = describe "Queries" $ do
94  propP   "ap"         test_ap
95  propP   "bcc"        test_bcc
96  describe "BFS" $ do
97    propP "bfs"        test_bfs
98    propP "level"      test_level
99  describe "DFS" $ do
100    propP "components"   test_components
101    propP "scc"          test_scc
102    propP "reachable"    test_reachable
103    propP "condensation" test_condensation
104  describe "Dominators" $ do
105    test_dom
106    test_iDom
107  describe "GVD" $ do
108    test_voronoiSet
109    test_nearestNode
110    test_nearestDist
111    test_nearestPath
112  describe "Indep"  . keepSmall $ do
113    -- Due to exponential behaviour of indep, limit the maximum size.
114    propP  "indepSize" test_indepSize
115    propP  "indep"     test_indep
116  test_maxFlow2
117  test_maxFlow
118  propP "msTree"       test_msTree
119  describe "SP" $ do
120    propP "sp"         test_sp
121    propP "sp_Just"    test_sp_Just
122    propP "sp_Nothing" test_sp_Nothing
123  keepSmall $ do
124    -- Just producing the sample graph to compare against is O(|V|^2)
125    propP "trc"        test_trc
126    propP "tc"         test_tc
127    propP "rc"         test_rc
128  where
129    propP str = prop str . ($p)
130
131    p :: PatriciaTreeP
132    p = Proxy
133
134    keepSmall = modifyMaxSize (min 30)
135