{- | Module : Data.GraphViz.Testing Description : Test-suite for graphviz. Copyright : (c) Ivan Lazar Miljenovic License : 3-Clause BSD-style Maintainer : Ivan.Miljenovic@gmail.com This defines a test-suite for the graphviz library. Limitations of the test suite are as follows: * For the most part, this library lets you use arbitrary numbers for String values. However, this is not tested due to too many corner cases for special parsers that don't take arbitrary Strings. As the Dot standard is ambiguous over whether you can or can't use numbers as Strings (more specifically, if they should be quoted or not), this is a user beware situation. * Same goes for empty Strings; sometimes they're allowed, sometimes they're not. Thus, to simplify matters they're not generated. * The generated Strings are very simple, only composed of lower case letters, digits and some symbols. This is because too many tests were \"failing\" due to some corner case; e.g. lower-case letters only because the parser parses Strings as lowercase, so if a particular String isn't valid (e.g. @\"all\"@ for 'LayerID', then the 'Arbitrary' instance has to ensure that all possible ways of capitalising that String isn't generated as a random 'LRName'. * The generated 'DotGraph's are not guaranteed to be valid; as such, the 'prop_parsePrettyID' property is not able to be tested as dot, etc. choke on invalid Dot code. * To avoid needless endless recursion, 'DotSubGraph's do not have sub-'DotSubGraph's (same with 'GDotSubGraph's). * This test suite isn't perfect: if you deliberately try to stuff something up, you probably can. -} module Data.GraphViz.Testing ( -- * Running the test suite. runChosenTests , runTests , runTest -- ** The tests themselves , Test(..) , defaultTests , test_printParseID_Attributes , test_generalisedSameDot , test_printParseID , test_preProcessingID , test_parsePrettyID , test_dotizeAugment , test_dotizeAugmentUniq -- * Re-exporting modules for manual testing. , module Data.GraphViz , module Data.GraphViz.Types.Generalised , module Data.GraphViz.Testing.Properties -- * Debugging printing , PrintDot(..) , printIt , renderDot -- * Debugging parsing , ParseDot(..) , parseIt , runParser , preProcess ) where import Test.QuickCheck import Data.GraphViz.Testing.Instances() -- This module cannot be re-exported from Instances, as it causes -- Overlapping Instances. import Data.GraphViz.Testing.Instances.FGL() import Data.GraphViz.Testing.Properties import Data.GraphViz hiding (RunResult(..)) import Data.GraphViz.Parsing(ParseDot(..), parseIt, runParser) import Data.GraphViz.PreProcessing(preProcess) import Data.GraphViz.Printing(PrintDot(..), printIt, renderDot) import Data.GraphViz.Types.Generalised hiding ( GraphID(..) , GlobalAttributes(..) , DotNode(..) , DotEdge(..)) -- Can't use PatriciaTree because a Show instance is needed. import Data.Graph.Inductive.Tree(Gr) import System.Exit(ExitCode(..), exitWith) import System.IO(hPutStrLn, stderr) -- ----------------------------------------------------------------------------- runChosenTests :: [Test] -> IO () runChosenTests tests = do putStrLn msg blankLn runTests tests spacerLn putStrLn successMsg where msg = "This is the test suite for the graphviz library.\n\ \If any of these tests fail, please inform the maintainer,\n\ \including full output of this test suite." successMsg = "All tests were successful!" -- ----------------------------------------------------------------------------- -- Defining a Test structure and how to run tests. -- | Defines the test structure being used. data Test = Test { name :: String , lookupName :: String -- ^ Should be lowercase , desc :: String , test :: IO Result -- ^ QuickCheck test. } -- | Run all of the provided tests. runTests :: [Test] -> IO () runTests = mapM_ ((>>) spacerLn . runTest) -- | Run the provided test. runTest :: Test -> IO () runTest tst = do putStrLn title blankLn putStrLn $ desc tst blankLn r <- test tst blankLn case r of Success{} -> putStrLn successMsg GaveUp{} -> putStrLn gaveUpMsg _ -> die failMsg blankLn where nm = '"' : name tst ++ "\"" title = "Running test: " ++ nm ++ "." successMsg = "All tests for " ++ nm ++ " were successful!" gaveUpMsg = "Too many sample inputs for " ++ nm ++ " were rejected;\n\ \tentatively marking this as successful." failMsg = "The tests for " ++ nm ++ " failed!\n\ \Not attempting any further tests." spacerLn :: IO () spacerLn = putStrLn (replicate 70 '=') >> blankLn blankLn :: IO () blankLn = putStrLn "" die :: String -> IO a die msg = do hPutStrLn stderr msg exitWith (ExitFailure 1) -- ----------------------------------------------------------------------------- -- Defining the tests to use. -- | The tests to run by default. defaultTests :: [Test] defaultTests = [ test_printParseID_Attributes , test_generalisedSameDot , test_printParseID , test_printParseGID , test_preProcessingID -- Can't run this test, since we don't generate valid -- DotGraphs to pass to Graphviz! -- , test_parsePrettyID , test_dotizeAugment , test_dotizeAugmentUniq , test_findAllNodes , test_findAllNodesG , test_findAllNodesE , test_findAllNodesEG , test_findAllEdges , test_findAllEdgesG , test_noGraphInfo , test_noGraphInfoG ] -- | Test that 'Attributes' can be printed and then parsed back. test_printParseID_Attributes :: Test test_printParseID_Attributes = Test { name = "Printing and parsing of Attributes" , lookupName = "attributes" , desc = dsc , test = quickCheckWithResult args prop } where prop :: Attributes -> Property prop = prop_printParseListID args = stdArgs { maxSuccess = numGen } numGen = 10000 defGen = maxSuccess stdArgs dsc = "The most common source of errors in printing and parsing are for\n\ \Attributes. As such, these are stress-tested before we run the\n\ \rest of the tests, generating " ++ show numGen ++ " lists of\n\ \Attributes rather than the default " ++ show defGen ++ " tests." test_generalisedSameDot :: Test test_generalisedSameDot = Test { name = "Printing generalised Dot code" , lookupName = "makegeneralised" , desc = dsc , test = quickCheckResult prop } where prop :: DotGraph Int -> Bool prop = prop_generalisedSameDot dsc = "When generalising \"DotGraph\" values to \"GDotGraph\" values,\n\ \the generated Dot code should be identical." test_printParseID :: Test test_printParseID = Test { name = "Printing and Parsing DotGraphs" , lookupName = "printparseid" , desc = dsc , test = quickCheckResult prop } where prop :: DotGraph Int -> Bool prop = prop_printParseID dsc = "The graphviz library should be able to parse back in its own\n\ \generated Dot code. This test aims to determine the validity\n\ \of this for the overall \"DotGraph Int\" values." test_printParseGID :: Test test_printParseGID = Test { name = "Printing and Parsing Generalised DotGraphs" , lookupName = "printparseidg" , desc = dsc , test = quickCheckResult prop } where prop :: GDotGraph Int -> Bool prop = prop_printParseID dsc = "The graphviz library should be able to parse back in its own\n\ \generated Dot code. This test aims to determine the validity\n\ \of this for the overall \"GDotGraph Int\" values." test_preProcessingID :: Test test_preProcessingID = Test { name = "Pre-processing Dot code" , lookupName = "preprocessing" , desc = dsc , test = quickCheckResult prop } where prop :: DotGraph Int -> Bool prop = prop_preProcessingID dsc = "When parsing Dot code, some pre-processing is done to remove items\n\ \such as comments and to join together multi-line strings. This\n\ \test verifies that this pre-processing doesn't affect actual\n\ \Dot code by running the pre-processor on generated Dot code.\n\n\ \This test is not run on generalised Dot graphs as if it works for\n\ \normal dot graphs then it should also work for generalised ones." -- | This test is not valid for use until valid DotGraphs can be generated. test_parsePrettyID :: Test test_parsePrettyID = Test { name = "Parsing pretty-printed code" , lookupName = "parsepretty" , desc = dsc , test = quickCheckResult prop } where prop :: DotGraph Int -> Bool prop = prop_parsePrettyID dsc = "By default, the graphviz library doesn't produce readable Dot\n\ \code to ensure that lines aren't truncated, etc. This test\n\ \ensures that the pretty-printing functions produce Dot code\n\ \that is still parseable (which should also help ensure that\n\ \ \"Real-World\" Dot code is also parseable)." test_dotizeAugment :: Test test_dotizeAugment = Test { name = "Augmenting FGL Graphs" , lookupName = "augment" , desc = dsc , test = quickCheckResult prop } where prop :: Gr Char Double -> Bool prop = prop_dotizeAugment dsc = "The various Graph to Graph functions in Data.GraphViz should\n\ \only _augment_ the graph labels and not change the graphs\n\ \themselves. This test compares the original graphs to these\n\ \augmented graphs and verifies that they are the same." test_dotizeAugmentUniq :: Test test_dotizeAugmentUniq = Test { name = "Unique edges in augmented FGL Graphs" , lookupName = "augmentuniq" , desc = dsc , test = quickCheckResult prop } where prop :: Gr Char Double -> Bool prop = prop_dotizeAugmentUniq dsc = "When augmenting a graph with multiple edges, as long as no\n\ \Attributes are provided that override the default settings,\n\ \then each edge between two nodes should have a unique position\n\ \Attribute, etc." test_findAllNodes :: Test test_findAllNodes = Test { name = "Ensure all nodes are found in a DotGraph" , lookupName = "findnodes" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_findAllNodes dsc = "nodeInformation should find all nodes in a DotGraph;\n\ \this is tested by converting an FGL graph and comparing\n\ \the nodes it should have to those that are found." test_findAllNodesG :: Test test_findAllNodesG = Test { name = "Ensure all nodes are found in a GDotGraph" , lookupName = "findnodesg" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_findAllNodesG dsc = "nodeInformation should find all nodes in a GDotGraph;\n\ \this is tested by converting an FGL graph and comparing\n\ \the nodes it should have to those that are found." test_findAllNodesE :: Test test_findAllNodesE = Test { name = "Ensure all nodes are found in a node-less DotGraph" , lookupName = "findedgelessnodes" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_findAllNodesE dsc = "nodeInformation should find all nodes in a DotGraph,\n\ \even if there are no explicit nodes in that graph.\n\ \This is tested by converting an FGL graph and comparing\n\ \the nodes it should have to those that are found." test_findAllNodesEG :: Test test_findAllNodesEG = Test { name = "Ensure all nodes are found in a node-less GDotGraph" , lookupName = "findedgelessnodesg" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_findAllNodesEG dsc = "nodeInformation should find all nodes in a GDotGraph,\n\ \even if there are no explicit nodes in that graph.\n\ \This is tested by converting an FGL graph and comparing\n\ \the nodes it should have to those that are found." test_findAllEdges :: Test test_findAllEdges = Test { name = "Ensure all edges are found in a DotGraph" , lookupName = "findedges" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_findAllEdges dsc = "nodeInformation should find all edges in a DotGraph;\n\ \this is tested by converting an FGL graph and comparing\n\ \the edges it should have to those that are found." test_findAllEdgesG :: Test test_findAllEdgesG = Test { name = "Ensure all edges are found in a GDotGraph" , lookupName = "findedgesg" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_findAllEdgesG dsc = "nodeInformation should find all edges in a GDotGraph;\n\ \this is tested by converting an FGL graph and comparing\n\ \the edges it should have to those that are found." test_noGraphInfo :: Test test_noGraphInfo = Test { name = "Plain DotGraphs should have no structural information" , lookupName = "nographinfo" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_noGraphInfo dsc = "When converting a Graph to a DotGraph, there should be no\n\ \clusters or global attributes." test_noGraphInfoG :: Test test_noGraphInfoG = Test { name = "Plain GDotGraphs should have no structural information" , lookupName = "nographinfog" , desc = dsc , test = quickCheckResult prop } where prop :: Gr () () -> Bool prop = prop_noGraphInfoG dsc = "When converting a Graph to a GDotGraph, there should be no\n\ \clusters or global attributes."