TestExplode (empty) → 0.1.0.0
raw patch · 13 files changed
+2108/−0 lines, 13 filesdep +basedep +containersdep +directorysetup-changed
Dependencies added: base, containers, directory, fgl, graphviz, interpolatedstring-perl6, mtl, process, text
Files
- LICENSE +165/−0
- README.md +113/−0
- Setup.hs +2/−0
- TestExplode.cabal +80/−0
- doc/examples/Example1.hs +201/−0
- doc/examples/FinalIO.hs +105/−0
- doc/examples/Te23.hs +155/−0
- doc/examples/Te52.hs +183/−0
- doc/examples/Te_LA.hs +200/−0
- doc/examples/Te_LA2.hs +200/−0
- doc/examples/VizViews.hs +85/−0
- src/TestExplode/DirGraphCombine.hs +155/−0
- src/TestExplode/TestExplode.hs +464/−0
+ LICENSE view
@@ -0,0 +1,165 @@+ GNU LESSER GENERAL PUBLIC LICENSE+ Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.+++ This version of the GNU Lesser General Public License incorporates+the terms and conditions of version 3 of the GNU General Public+License, supplemented by the additional permissions listed below.++ 0. Additional Definitions.++ As used herein, "this License" refers to version 3 of the GNU Lesser+General Public License, and the "GNU GPL" refers to version 3 of the GNU+General Public License.++ "The Library" refers to a covered work governed by this License,+other than an Application or a Combined Work as defined below.++ An "Application" is any work that makes use of an interface provided+by the Library, but which is not otherwise based on the Library.+Defining a subclass of a class defined by the Library is deemed a mode+of using an interface provided by the Library.++ A "Combined Work" is a work produced by combining or linking an+Application with the Library. The particular version of the Library+with which the Combined Work was made is also called the "Linked+Version".++ The "Minimal Corresponding Source" for a Combined Work means the+Corresponding Source for the Combined Work, excluding any source code+for portions of the Combined Work that, considered in isolation, are+based on the Application, and not on the Linked Version.++ The "Corresponding Application Code" for a Combined Work means the+object code and/or source code for the Application, including any data+and utility programs needed for reproducing the Combined Work from the+Application, but excluding the System Libraries of the Combined Work.++ 1. Exception to Section 3 of the GNU GPL.++ You may convey a covered work under sections 3 and 4 of this License+without being bound by section 3 of the GNU GPL.++ 2. Conveying Modified Versions.++ If you modify a copy of the Library, and, in your modifications, a+facility refers to a function or data to be supplied by an Application+that uses the facility (other than as an argument passed when the+facility is invoked), then you may convey a copy of the modified+version:++ a) under this License, provided that you make a good faith effort to+ ensure that, in the event an Application does not supply the+ function or data, the facility still operates, and performs+ whatever part of its purpose remains meaningful, or++ b) under the GNU GPL, with none of the additional permissions of+ this License applicable to that copy.++ 3. Object Code Incorporating Material from Library Header Files.++ The object code form of an Application may incorporate material from+a header file that is part of the Library. You may convey such object+code under terms of your choice, provided that, if the incorporated+material is not limited to numerical parameters, data structure+layouts and accessors, or small macros, inline functions and templates+(ten or fewer lines in length), you do both of the following:++ a) Give prominent notice with each copy of the object code that the+ Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the object code with a copy of the GNU GPL and this license+ document.++ 4. Combined Works.++ You may convey a Combined Work under terms of your choice that,+taken together, effectively do not restrict modification of the+portions of the Library contained in the Combined Work and reverse+engineering for debugging such modifications, if you also do each of+the following:++ a) Give prominent notice with each copy of the Combined Work that+ the Library is used in it and that the Library and its use are+ covered by this License.++ b) Accompany the Combined Work with a copy of the GNU GPL and this license+ document.++ c) For a Combined Work that displays copyright notices during+ execution, include the copyright notice for the Library among+ these notices, as well as a reference directing the user to the+ copies of the GNU GPL and this license document.++ d) Do one of the following:++ 0) Convey the Minimal Corresponding Source under the terms of this+ License, and the Corresponding Application Code in a form+ suitable for, and under terms that permit, the user to+ recombine or relink the Application with a modified version of+ the Linked Version to produce a modified Combined Work, in the+ manner specified by section 6 of the GNU GPL for conveying+ Corresponding Source.++ 1) Use a suitable shared library mechanism for linking with the+ Library. A suitable mechanism is one that (a) uses at run time+ a copy of the Library already present on the user's computer+ system, and (b) will operate properly with a modified version+ of the Library that is interface-compatible with the Linked+ Version.++ e) Provide Installation Information, but only if you would otherwise+ be required to provide such information under section 6 of the+ GNU GPL, and only to the extent that such information is+ necessary to install and execute a modified version of the+ Combined Work produced by recombining or relinking the+ Application with a modified version of the Linked Version. (If+ you use option 4d0, the Installation Information must accompany+ the Minimal Corresponding Source and Corresponding Application+ Code. If you use option 4d1, you must provide the Installation+ Information in the manner specified by section 6 of the GNU GPL+ for conveying Corresponding Source.)++ 5. Combined Libraries.++ You may place library facilities that are a work based on the+Library side by side in a single library together with other library+facilities that are not Applications and are not covered by this+License, and convey such a combined library under terms of your+choice, if you do both of the following:++ a) Accompany the combined library with a copy of the same work based+ on the Library, uncombined with any other library facilities,+ conveyed under the terms of this License.++ b) Give prominent notice with the combined library that part of it+ is a work based on the Library, and explaining where to find the+ accompanying uncombined form of the same work.++ 6. Revised Versions of the GNU Lesser General Public License.++ The Free Software Foundation may publish revised and/or new versions+of the GNU Lesser General Public License from time to time. Such new+versions will be similar in spirit to the present version, but may+differ in detail to address new problems or concerns.++ Each version is given a distinguishing version number. If the+Library as you received it specifies that a certain numbered version+of the GNU Lesser General Public License "or any later version"+applies to it, you have the option of following the terms and+conditions either of that published version or of any later version+published by the Free Software Foundation. If the Library as you+received it does not specify a version number of the GNU Lesser+General Public License, you may choose any version of the GNU Lesser+General Public License ever published by the Free Software Foundation.++ If the Library as you received it specifies that a proxy can decide+whether future versions of the GNU Lesser General Public License shall+apply, that proxy's public statement of acceptance of any version is+permanent authorization for you to choose that version for the+Library.
+ README.md view
@@ -0,0 +1,113 @@+README+------++TestExplode -- let the set of your test cases explode !+++Motivation and what the heck this module does+-----------------------------------------------++"DRY, Don't repeat yourself" is not valid, if you write testcases.+Every time you use the same sort of code, with different values+for variables or another function at one place.+Copy & paste is your friend.++That need not to be!+This module shall enable you to write the structure of whole test sets.++You have two building blocks:++1. variables that can change. Every testcase uses another combination+of variables. For defining the set of variables you can use the+list-comprehension of haskell.++2. Define the structure of your testcases as directed graphs with one+begin and one end.+Every path of the graph forms one testcase. And this testcase is+generated with all the variable-combinations, that you have defined +with the method of 1.)++Additionally:++3. Why not combine existing testcases with new testcases ?+You can import another testgraphs. You must only cast the types of +variables that the imported testgraph uses.++4. Defining what the testcase shall do is one thing, defining what the+expected outcome of the testcase is is the other.+To every snippet of the testcase you can add the state of the system +under test, using the input testdata and the state of the system under+test before that snippet. The state you can use in defining+the result of the test.++The module combines texts, that you write. This texts are snippets+of the testcase. So in the text you can use whatever language you want,+the resulting testcase is in this language.++To make the testcase well commented, you must say, what the +comment-chars of your text/programming language are. If you write+python or perl this are "# ", in haskell "-- ".++The official modules of this package generate you a sequence of+Texts. Every text is a testcase. To make files out of the text, with a+header and a footer and a nice name, the module FinalIO.hs in the +doc/examples-directory can be used. Because the module is not so+modular, and every user wants a bit other header and footers,+it is not an official module. But it works for me.+Feel free to change it.++For the same reasons the module VizViews.hs is not an official module+and included in the directory docs/examples.+This module defines attributes for graphviz. By that we come to the +next feature of TextExplode: Visualization of the testgraph.++The testgraph is a graph and can be printed with graphviz.+Subgraphs can be hidden in a node and with a click on the node you+come to the subgraph. This modules use graphviz and interpret the+testgraphs, so that they can be printed with graphviz.++Installation+-------------++ mkdir TestExplode+ cd TestExplode+ cabal sandbox init+ cabal install TestExplode++should do the job.++Additionally install graphviz with your package manager or on windows +with the instructions at http://graphviz.org/+++Usage+------++There are examples in the directory doc/examples.+I recommend Te_LA.hs as a starting point.+After you have understood the design of a testcase, you can go further+and understand, how testcses are iported with the example Te52.hs.++Of course the most complete docu is the haddock documentation of this+module.++The command for generating the testcases out of Te_LA.hs is:++ runghc Te_LA.hs++The resulting testcases can be found in Te_LA/*.rb.+The resulting Testgraph can be found under Te_LA/Te_LA.svg.++The subgraphs can be found under subgraphs/.+++Much fun and I like getting mails about the usage of the module.+Write me, if you like!+++++++ +
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ TestExplode.cabal view
@@ -0,0 +1,80 @@+-- Initial TestExplode.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: TestExplode++-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++-- A short (one-line) description of the package.+synopsis: Generates testcases from program-snippets++-- A longer description of the package.+description: Generates testcases from program-snippets in any language, with varables, that are substituted and a directed graph structure of the snippets and "test hints" ++-- URL for the project homepage or repository.+homepage: https://github.com/testexplode/testexplode +++-- The license under which the package is released.+license: LGPL-3++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: Hans-Jürgen Guth++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: juergen.software@freea2a.de++-- A copyright notice.+copyright: (c) Hans-Jürgen Guth 2015++category: Testing++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files:+ README.md + doc/examples/*.hs+++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10++-- The repository and tag of the sources+source-repository this+ type: git+ location: git://github.com/testexplode/testexplode.git+ tag: 0.1.0.0+++library+ -- Modules exported by the library.+ exposed-modules: TestExplode.TestExplode, TestExplode.DirGraphCombine+ + -- Modules included in this library but not exported.+ -- other-modules: + + -- LANGUAGE extensions used by modules in this package.+ other-extensions: QuasiQuotes, ExtendedDefaultRules, OverloadedStrings+ + -- Other library packages from which modules are imported.+ build-depends: base >=4.7 && <4.8, interpolatedstring-perl6 >=0.9 && <0.10, text >=1.2 && <1.3, fgl >=5.5 && <5.6, graphviz >=2999.17 && <2999.18, process >=1.2 && <1.3, directory >=1.2 && <1.3, mtl >=2.2 && <2.3, containers >=0.5 && <0.6+ + -- Directories containing source files.+ hs-source-dirs: src+ + -- Base language which the package is written in.+ default-language: Haskell2010+
+ doc/examples/Example1.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules, OverloadedStrings #-}++module Example1 where -- exports everything, thus import only qualified!++import qualified Te_LA2 as Te_LA++import TestExplode.TestExplode+import TestExplode.DirGraphCombine+import VizViews+import FinalIO++import Text.InterpolatedString.Perl6 (qc)+import qualified Data.Text.Lazy as L++-- SIG=2 (take VGR immediately)++data Ex1Cnf = Ex1Cnf {vz1kmh :: Int,+ vgr2kmh :: Int+ }+ deriving (Show)+ +ex1Testset = [Ex1Cnf { vz1kmh = vz,+ vgr2kmh = vgr+ } + | vz <- [0, 10, 30, 80],+ vgr <- [10, 15, 30, 80]+ ]+ +data Ex1Hints = Ex1Hints {distanceToZ :: Int, -- cm+ currSpeed :: Int -- km/h+ } + deriving (Show)+ +-- Power Up+++initCp = emptyCp { shortDesc = "Power Up with special SSE-Data",+ longDesc = "Power Up with special SSE-Data",+ codeFkt = \cnf hints -> [qc|+ignoreErrorMessages([1,2,404]);+setDqTraceOn(["WSATP_01"]);+setXtracesOn([190, 8, 9, 212]);++hochlaufSSE("ZB"=>1000, "BB"=>1000, "BBA1"=>100, "ZBA1"=>100, + "SZKS"=> 20*100, "VMAX"=>100, "TYP"=>1000);+|]+ }+ +-- First GKS +++firstGKS = emptyCp { shortDesc = "Define first GKS with chosen VZ\nand VGR=30",+ longDesc = "Define first GKS with chosen VZ\nand VGR=30",+ codeFkt = \cnf hints -> [qc|+anfahrenKmH(20, 10); # to 10 km/h in 20 m++clearBalise();+addPacket(7, \{"VGR"=>30, "VZ"=>{vz1kmh cnf}, "Z"=>400\});+defineGKS("GKS1");+|],+ varFkt = \cnf hints -> hints{currSpeed=10}+ }+-- Mark+++markGKS1 = markCp "GKS1"++-- Send GKS1+++sendGKS = emptyCp { shortDesc = "Send first GKS and Check 30 km/h",+ longDesc = "Send first GKS and Check 30 km/h",+ codeFkt = \cnf hints -> [qc|+ueberfahreGKS("GKS1", 3);+godistance(20);+checkATPGeschwindigkeit(\{"Exaktwert", "Vsoll", 30 - 0.1, 30, "GKS1"\});+|],+ varFkt = \cnf hints -> hints{distanceToZ = 400 -20 -3-2}+ } + +-- receive infill+infillCp = emptyCp { shortDesc = "Send infill with chosen VGR\nand SIG=2 and drive and check V",+ longDesc = "Send infill with chosen VGR\nand SIG=2 and drive and check V",+ codeFkt = \cnf hints -> [qc|+clearBalise();+addPacket(7, \{"VGR"=>{vgr2kmh cnf}, "VZ"=>0, "Z"=>1000, "SIG"=>2\});+defineGKS("infill");+# intern variables: {hints}+startFunkaufwertung("ZRADIOA", "infill");+godistance(20);+checkATPGeschwindigkeitT(\{"Exaktwert", "Vsoll", {max (30, vgr2kmh cnf) - 0.1, max (30, vgr2kmh cnf), 400\});+|],+ varFkt = \cnf hints -> hints{distanceToZ = (distanceToZ hints) - 20 }+ }++-- Mark+markInfill = markCp "Infill"+++-- If downgrade, drive till begin of braking curve++-- Helper function, a pseudo-braking curve+way2Z :: Int -> Int -> Int -> Int+way2Z a b c = a - floor ( (fromIntegral (b-c))/ (2.0*3.6)) +++curveBeginCp = emptyCp{ shortDesc = "drive till begin and in \n braking curve and check",+ longDesc = "drive till begin and in \n braking curve and check",+ codeFkt = \cnf hints ->+let wayToDrive = (distanceToZ hints) - way2Z (distanceToZ hints) (vgr2kmh cnf) 30+in +[qc|+# intern variables: {hints}+goDistance({wayToDrive}-1);+checkAtpGeschwindigkeit(\{"Exaktwert", "Vsoll", 30 - 0.1,30, "Infill"\});+godistance(2);+checkAtpGeschwindigkeitT(\{"Exaktwert", "Vsoll", 30 - 0.6,30-0.2 , 300\});+ +|],+ varFkt = \cnf hints ->+ let wayToDrive = (distanceToZ hints) - way2Z (distanceToZ hints) (vgr2kmh cnf) 30+ in+ hints{distanceToZ = (distanceToZ hints) - wayToDrive -1},+ condition = \cnf hints -> (vgr2kmh cnf) < 30,+ condDesc = "VGR(Infill) < 30"+ }+ ++-- if upgrade, test emergency brake++upgradeCp = emptyCp{ shortDesc = "EB due to overspeed",+ longDesc = "EB due to overspeed",+ codeFkt = \cnf hints ->+[qc|+accelmeter({vgr2kmh cnf}, 30);+setMark("equalSpeed");+accelmeter({(vgr2kmh cnf + 1)}, 1);+godistance(5);+checkZB("Sollwert","on", "equalSpeed");+godistance({distanceToZ hints});+checkZB("Tabuwert","off", "equalSpeed");+|], + condition = \cnf hints -> (vgr2kmh cnf) >= 30, + condDesc = "VGR(Infill) >= 30"+ }+ + +-- the special conversion functions++toTeLACnf :: Ex1Cnf -> Te_LA.TeLACnf+toTeLACnf myCnf = Te_LA.TeLACnf {Te_LA.allowedSpeed = 25,+ Te_LA.markName = "Mark_SpeedRest"+ } + +useVarsTeLA :: Ex1Hints -> Te_LA.TeLAVars+useVarsTeLA myHint = Te_LA.TeLAVars 0++takeVarsTeLA :: Ex1Hints -> Te_LA.TeLAVars -> Ex1Hints+takeVarsTeLA myHint itsHint = + myHint{ distanceToZ = (distanceToZ myHint)+ + (Te_LA.runnedDistance itsHint)+ }+++-- the complete graph of the part-testcases ++testgraph = mkEle initCp+ &-&+ mkEle firstGKS+ &-&+ mkEle markGKS1+ &-&+ mkEle sendGKS+ &-&+ mkEle infillCp+ &-&+ mkEle markInfill+ &-&+ mkGraph2Ele toTeLACnf useVarsTeLA takeVarsTeLA NotExpand Te_LA.testgraph+ &-&+ split [mkEle curveBeginCp,+ mkEle upgradeCp+ ] +++printSubGraph :: String -> (String, Testgraph (CasepartInternal cnf locals )) -> IO ()+printSubGraph path (name, testgraph) = + let vizGraph = mkVizGraph (dirGraph testgraph)+ in+ printTestgraphP recordView1 vizGraph path name ++ +main :: IO ()+main = do + let testcases = generate "# " ex1Testset (Ex1Hints 0 0) (L.pack . show) testgraph+ printTestcases testcases+ let vizGraph = mkVizGraph testgraph+ printTestgraph recordView1 vizGraph+ -- Print the subgraphs+ let subGraphList = getSubGraphs testgraph []+ mapM_ (printSubGraph "subgraphs") subGraphList
+ doc/examples/FinalIO.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module : FinalIO+Description : The Final Functions for the end user. Writes many files.+Copyright : (c) Hans-Jürgen Guth, 2014+License : LGPL+Maintainer : juergen.software@freea2a.de+Stability : experimental++This Functions generate the testcases as executables and as visualisation.+-}++module FinalIO (printTestcases, printTestgraph, printTestgraphP) where++import TestExplode.DirGraphCombine (VizGraph)+import TestExplode.TestExplode (TGDocuInfo)++import Data.List++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.PatriciaTree (Gr)+import Data.GraphViz++import qualified Data.Text.Lazy as L++import System.IO+import System.Process+import System.Environment+import System.Directory++-- | Change this function, if you need or like+induvidualizeTestcase :: L.Text -- ^ the filename of the testcase + -> (Int, L.Text) -- ^ (number of the testcase, + -- testcase)+ -> (Int, L.Text) -- ^ (number of the testcase,+ -- testcase with header and footer) +induvidualizeTestcase filename (n, str) =+ (n, L.concat["# Testcase ", L.pack (show n), "\n",+ str,+ L.pack "\ngenerate(\"",+ filename, "_", L.pack (show n), ".ssd\");"])+++-- | here you can change the extension of the filename of the testcase +mkFile :: L.Text -> (Int, L.Text) -> IO () +mkFile filename (n, str) = do+ outFile <- openFile (L.unpack((L.concat[filename,"_", L.pack (show n), ".rb"]))) WriteMode+ hPutStr outFile (L.unpack str)+ hClose outFile + ++-- | Takes the testcases in '[String]' and prints the+-- strings in a subdirectory called as the executable, which+-- calls this function, the name stripped after the first ".". +printTestcases :: [L.Text] -> IO ()+printTestcases testcases = do + putStr $ show (length testcases) ++ " testcases\n"+ -- mapAccumL is a bit complicated,+ -- numberedTestcases is a structure of [(1, testcase 1), + -- (2, testcase 2),+ -- ..+ -- (n, testcase n)] + let numberedTestcases = snd $ mapAccumL (\ n str -> (n+1, (n,str))) 1 testcases+ testgraphnameCompl <- getProgName+ let testgraphname = L.pack $ takeWhile (/='.') testgraphnameCompl+ let idTestcases = map (induvidualizeTestcase testgraphname) numberedTestcases+ createDirectoryIfMissing False (L.unpack testgraphname)+ let testgraphpath = L.concat [testgraphname,"/",testgraphname]+ mapM_ (mkFile testgraphpath ) idTestcases++-- | Prints the testgraph as *.dot and *.svg in the subdirectory +printTestgraph :: GraphvizParams Node (Maybe a, Maybe TGDocuInfo) () () (Maybe a, Maybe TGDocuInfo) -- ^ The GraphvizParams+ -> (VizGraph a) -- ^ The VizGraph as input+ -> IO () -- ^ the result is 'IO'+printTestgraph view vizGraph = do+ let myVis = \graph -> graphToDot view graph+ let code = L.unpack $ printDotGraph (myVis vizGraph)+ testgraphnameCompl <- getProgName+ let testgraphname = fst $ span (/='.') testgraphnameCompl+ let testgraphpath = testgraphname ++ "/" ++ testgraphname+ outGraphFile <- openFile (testgraphpath ++".dot") WriteMode+ hPutStr outGraphFile code + hClose outGraphFile+ callCommand ( "dot -Tsvg -o " ++ testgraphpath ++".svg " +++ testgraphpath ++".dot")+ +-- | prints the testgraph as *.dot and *.svg with name and path+printTestgraphP :: GraphvizParams Node (Maybe a, Maybe TGDocuInfo) () () (Maybe a, Maybe TGDocuInfo) -- ^ The GraphvizParams+ -> (VizGraph a) -- ^ The VizGraph as input+ -> String -- ^ the path to the file that shall be generated+ -> String -- ^ the filename of the file that shall be generated+ -> IO () -- ^ the result is 'IO'+printTestgraphP view vizGraph path name = do+ let myVis = \graph -> graphToDot view graph+ let code = L.unpack $ printDotGraph (myVis vizGraph)+ let testgraphpath = path ++ "/" ++ name+ createDirectoryIfMissing True path+ outGraphFile <- openFile (testgraphpath ++".dot") WriteMode+ hPutStr outGraphFile code + hClose outGraphFile+ callCommand ( "dot -Tsvg -o " ++ testgraphpath ++".svg " +++ testgraphpath ++".dot")++
+ doc/examples/Te23.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules #-}++module Te23 where -- exports everything, thus import only qualified!++import qualified Te_LA ++import TestExplode.TestExplode3+import TestExplode.DirGraphCombine+import VizViews+import FinalIO+++import Text.InterpolatedString.Perl6 (qc)++++-- failure of the Speed Measurement, a short and a long time+++data Te23Cnf = + Te23Cnf { durationOfFailure :: Int+ ,speed :: Int+ ,percentageOfFailure :: Int+ ,wisirNo :: Int+ }+ deriving (Show)+ +te23Testset = [ Te23Cnf { durationOfFailure = dura,+ speed = v,+ percentageOfFailure = perc,+ wisirNo = wiNo + }+ |+ dura <- [0,100], --,200,999, 1001, 5000],+ v <- [1, 10], --, 50,100],+ perc <- [0,1], --9,11, 50, 100],+ wiNo <- [1,2]+ ] ++ +-- Parts of testcases (Casepart's)++-- Power Up++startRunCode :: Te23Cnf -> String+startRunCode cfg = [qc|+ switchOn();+ testTheUnit(ok);+ accelerateTo({speed cfg});+ wait(10000)+|]++startRunCp = emptyCp + { shortDesc = "Start up and run",+ longDesc = "Switch the unit on\n Make functional test\n Accelerate to target speed",+ codeFkt = startRunCode+ }++-- Difference of the Speed measurement+ +makeDifferenceCode :: Te23Cnf -> String+makeDifferenceCode cfg = [qc|+ wisirSpeed({wisirNo cfg}, { fromIntegral (speed cfg)* (1-(fromIntegral (percentageOfFailure cfg)/100.0))} );+ wait({durationOfFailure cfg});+|]++makeDifferenceCp = emptyCp+ { shortDesc = "The 2 Speed measurements differ \n(or not)\nfor the given time",+ longDesc = "The 2 Speed measurements differ \n(or not)\nfor the given time",+ codeFkt = makeDifferenceCode+ }++-- Check: Error!+ +checkNotOKCode :: Te23Cnf -> String+checkNotOKCode cfg = [qc|+ checkFailure(400, 208);+|]+++checkNotOkCondition :: Te23Cnf -> Bool+checkNotOkCondition cfg = (percentageOfFailure cfg) > 10 && + (durationOfFailure cfg) > 1000++checkNotOkCp = emptyCp+ { shortDesc = "Check: Failure",+ longDesc = "Check: Failure",+ codeFkt = checkNotOKCode,+ condition = checkNotOkCondition,+ condDesc = "> 10 %, > 1 s"+ }+ +-- Check: No error+ +checkOKCode :: Te23Cnf -> String+checkOKCode cfg = [qc|+ checkFailure();+|]++checkOkCondition :: Te23Cnf -> Bool+checkOkCondition cfg = not (checkNotOkCondition cfg) ++checkOkCp = emptyCp+ { shortDesc = "Check: No failure",+ longDesc = "Check: No failure",+ codeFkt = checkOKCode,+ condition = checkOkCondition,+ condDesc = "not (> 10 %, > 1 s)"+ }++-- the special conversion function++toTeLA :: Te23Cnf -> Te_LA.TeLACnf+toTeLA te23 = Te_LA.TeLACnf {Te_LA.restOfRest = (durationOfFailure te23) * (speed te23) +10,+ Te_LA.allowedSpeed = 10,+ Te_LA.markName = "Mark_te23.1"+ } +++ +-- the complete graph of the part-testcases + ++testgraph = split [ mkEle startRunCp,+ mkGraph2Ele toTeLA NotExpand Te_LA.testgraph+ ]+ &-&+ mkEle makeDifferenceCp+ &-&+ split [ mkEle checkNotOkCp,+ mkEle checkOkCp+ ]+ +++printSubGraph :: String -> (String, Testgraph (Casepart cnf)) -> IO ()+printSubGraph path (name, testgraph) = + let vizGraph = mkVizGraph (dirGraph testgraph)+ in+ printTestgraphP recordView1 vizGraph path name ++ +main :: IO ()+main = do + let testcases = generate "# " te23Testset show testgraph+ printTestcases testcases+ let vizGraph = mkVizGraph testgraph+ printTestgraph recordView1 vizGraph+ -- Print the subgraphs+ let subGraphList = getSubGraphs testgraph []+ -- putStr $ show $ length subGraphList+ -- mapM_ (putStr . show . fst) subGraphList+ mapM_ (printSubGraph "subgraphs") subGraphList ++
+ doc/examples/Te52.hs view
@@ -0,0 +1,183 @@+{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules, OverloadedStrings #-}++module Te52 where -- exports everything, thus import only qualified!++import qualified Te_LA ++import TestExplode.TestExplode+import TestExplode.DirGraphCombine+import VizViews+import FinalIO+++import Text.InterpolatedString.Perl6 (qc)+import qualified Data.Text.Lazy as L+++-- failure of the Speed Measurement, a short and a long time+++data Te52Cnf = + Te52Cnf { durationOfFailure :: Int+ ,speed :: Int+ ,percentageOfFailure :: Int+ ,wisirNo :: Int+ }+ deriving (Show)++data Te52Locals =+ Te52Locals { currTime :: Int, -- ms+ currDistance :: Int -- cm+ }+ deriving (Show)+ +startLocals = Te52Locals 0 0+ +te52Testset = [ Te52Cnf { durationOfFailure = dura,+ speed = v,+ percentageOfFailure = perc,+ wisirNo = wiNo + }+ |+ dura <- [0,100], --,200,999, 1001, 5000],+ v <- [1, 10], --, 50,100],+ perc <- [0,9,11], --9,11, 50, 100],+ wiNo <- [1,2]+ ] ++ +-- Parts of testcases (Casepart's)++-- Power Up++startRunCode :: Te52Cnf -> Te52Locals-> L.Text+startRunCode cfg locals = [qc|+ switchOn();+ testTheUnit(ok);+ accelerateTo({speed cfg});+ wait(10000)+|]++startRunVars :: Te52Cnf -> Te52Locals -> Te52Locals+startRunVars cnf locals = locals{currTime = (currTime locals) + 10000,+ currDistance = (speed cnf) * 900 + (currDistance locals)+ }++startRunCp = emptyCp + { shortDesc = "Start up and run",+ longDesc = "Switch the unit on\n Make functional test\n Accelerate to target speed",+ codeFkt = startRunCode,+ varFkt = startRunVars+ }++-- Difference of the Speed measurement+ +makeDifferenceCode :: Te52Cnf -> Te52Locals -> L.Text+makeDifferenceCode cfg locals = [qc|+ # states of the variables: {locals}+ wisirSpeed({wisirNo cfg}, { fromIntegral (speed cfg)* (1-(fromIntegral (percentageOfFailure cfg)/100.0))} );+ wait({durationOfFailure cfg});+|]+++makeDifferenceVars cnf locals = + locals{currTime = round $ fromIntegral (currTime locals) * fromIntegral (percentageOfFailure cnf)/100.0}+++makeDifferenceCp = emptyCp+ { shortDesc = "The 2 Speed measurements differ \n(or not)\nfor the given time",+ longDesc = "The 2 Speed measurements differ \n(or not)\nfor the given time",+ codeFkt = makeDifferenceCode,+ varFkt = makeDifferenceVars+ }++-- Check: Error!+ +checkNotOKCode :: Te52Cnf -> Te52Locals -> L.Text+checkNotOKCode cfg locals = [qc|+ # states of the variables: {locals}+ checkFailure(400, 208);+|]+++checkNotOkCondition :: Te52Cnf -> Te52Locals -> Bool+checkNotOkCondition cfg locals = (percentageOfFailure cfg) > 10 && + (durationOfFailure cfg) > 1000++checkNotOkCp = emptyCp+ { shortDesc = "Check: Failure",+ longDesc = "Check: Failure",+ codeFkt = checkNotOKCode,+ condition = checkNotOkCondition,+ condDesc = "> 10 %, > 1 s"+ }+ +-- Check: No error+ +checkOKCode :: Te52Cnf -> Te52Locals -> L.Text+checkOKCode cfg locals = [qc|+ # states of the variables: {locals}+ checkFailure(None);+|]++checkOkCondition :: Te52Cnf -> Te52Locals -> Bool+checkOkCondition cfg locals = not (checkNotOkCondition cfg locals ) ++checkOkCp = emptyCp+ { shortDesc = "Check: No failure",+ longDesc = "Check: No failure",+ codeFkt = checkOKCode,+ condition = checkOkCondition,+ condDesc = "not (> 10 %, > 1 s)"+ }++-- the special conversion functions++toTeLACnf :: Te52Cnf -> Te_LA.TeLACnf+toTeLACnf te52 = Te_LA.TeLACnf {Te_LA.allowedSpeed = (speed te52),+ Te_LA.markName = "Mark_te52.1"+ } +useVarsTeLA :: Te52Locals -> Te_LA.TeLAVars+useVarsTeLA te52 = Te_LA.TeLAVars 0++takeVarsTeLA :: Te52Locals -> Te_LA.TeLAVars -> Te52Locals+takeVarsTeLA fromMaster fromEmbedded = + fromMaster{ currDistance = (currDistance fromMaster)+ + (1000 - (Te_LA.restOfRest fromEmbedded))+ }+ +-- the complete graph of the part-testcases + ++testgraph = split [ mkEle startRunCp,+ mkGraph2Ele toTeLACnf useVarsTeLA takeVarsTeLA NotExpand Te_LA.testgraph+ ]+ &-&+ mkEle makeDifferenceCp+ &-&+ split [ mkEle checkNotOkCp,+ mkEle checkOkCp+ ]+ +++printSubGraph :: String -> (String, Testgraph (CasepartInternal cnf locals )) -> IO ()+printSubGraph path (name, testgraph) = + let vizGraph = mkVizGraph (dirGraph testgraph)+ in+ printTestgraphP recordView1 vizGraph path name ++ +main :: IO ()+main = do + let testcases = generate "# " te52Testset startLocals (L.pack . show) testgraph+ printTestcases testcases+ let vizGraph = mkVizGraph testgraph+ printTestgraph recordView1 vizGraph+ -- Print the subgraphs+ let subGraphList = getSubGraphs testgraph []+ -- putStr $ show $ length subGraphList+ -- mapM_ (putStr . show . fst) subGraphList+ mapM_ (printSubGraph "subgraphs") subGraphList ++
+ doc/examples/Te_LA.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules, OverloadedStrings #-}+++-- This is an example of the domain train control.+-- You need not to understand every requirement,+-- But you should learn, how a testcase in TestExplode is build++module Te_LA where -- exports everything, thus import only qualified!+++import TestExplode.TestExplode+import TestExplode.DirGraphCombine+import VizViews+import FinalIO+++import Text.InterpolatedString.Perl6 (qc)++import qualified Data.Text.Lazy as L+++docuinfo = TGDocuInfo { descForTex = [qc|+ Entering a Speed Rest (SR) by all possibile ways,+ (checking the allowed Speed by driving faster:)+ possibile ways :+ GK 3 in SBE (entering SBE with all possibilites)+ GK 3 in SB+ GK2 by GKS+ GK2 by Infill+ GK2 behind SB+ Bhf's LA by GKS+ Bhf's LA by Infill|],+ name="LA_1",+ descForNode = "Entering a Speed Rest\n\+ \with all possibilities",+ generic = True,+ toExpand =True+ }+++testgraph = Testgraph { dirGraph = dirgraph,+ docuInfo = docuinfo+ }+-- -------+-- Definition of the test data+-- -------+++data TeLACnf = + TeLACnf { allowedSpeed :: Int+ ,markName :: String+ }+ deriving (Show)+ +teLATestset = [ TeLACnf { allowedSpeed = v,+ markName = "In_SR"+ }+ |+ v <- [5, 10, 15]+ ] ++data TeLAVars =+ TeLAVars { restOfRest :: Int }++ +-- ------+-- Definition of the dirGraph:+-- -----++ +-- Parts of testcases (Casepart's)++-- Power Up++startRunCode :: TeLACnf -> TeLAVars -> L.Text+startRunCode cfg locals = [qc|+ switchOn();+ testTheUnit(ok);+ accelerateTo({(allowedSpeed cfg) -2});+|]++startRunCp = emptyCp + { shortDesc = "Start up and run",+ longDesc = "Switch the unit on\n Make functional test\n Accelerate below allowed speed",+ codeFkt = startRunCode+ }+ +-- SBE by GKS GK1++sbeByGKS1Code :: TeLACnf -> TeLAVars -> L.Text+sbeByGKS1Code cnf locals = [qc|+ sendGKS(1, \{"SBE" =>1, "Z"=>20, "VZ"=> 80\});+ goDistance(25);|]+ + +sbeByGKS1Cp = emptyCp+ { shortDesc = "Reach SBE with\n GK1: SBE, Z=20, VZ=80\n 5 m behind Z",+ codeFkt = sbeByGKS1Code+ }+-- SBe by end of Stoerfahrtweglaenge+ +sbeByUeStoerCode cfg locals = [qc|+ makeFue(1);+ godistance(6);+ makeFue(0);+ goDistance(1010);|]+ +sbeByUeStoerCp = emptyCp+ { shortDesc = "Failure in Transmission,\nRide",+ longDesc = "Fue, No Fue, 1010 m ride",+ codeFkt = sbeByUeStoerCode+ }+ +-- receive GK3, enter LA++sendGK3code :: TeLACnf -> TeLAVars -> L.Text+sendGK3code cfg locals = [qc|+ sendGKS(3, "ZLA"=> 20, "VLA"=>{ fromIntegral( allowedSpeed cfg) / 5 }, "LLA" => 500 );+ godistance(20); |]+ +sendGK3vars cfg locals = TeLAVars 480 ++sendGK3Cp = emptyCp + { shortDesc ="Reach GK3-SR,\n 50 m until Z reached",+ codeFkt = sendGK3code,+ varFkt = sendGK3vars+ }+ +-- enter SB+enterSBcode :: TeLACnf -> TeLAVars -> L.Text+enterSBcode cfg locals = [qc|+ sendGKS(1, \{"Z"=> 3000\});+ godistance(10);|]++ +enterSBCp = emptyCp {+ shortDesc = "Enter Signal Run",+ codeFkt = enterSBcode+ }+ +-- makeMark++makeMark = emptyCp {+ shortDesc = "Mark",+ longDesc ="Mark",+ codeFkt = \cfg locals -> [qc|+ setCheckMark({markName cfg});|]+ }+ +-- check V++checkVcodeCp = emptyCp {+ shortDesc = "VLA (V of Speed rest)\n above and down again",+ codeFkt = \cfg locals -> [qc|+ testZBv({allowedSpeed cfg});|]+ }++-- Run till end of speed rest ++endLACp = emptyCp {+ shortDesc = "leaving SR and testing V",+ codeFkt = \cfg locals -> [qc|+ godistance ({(restOfRest locals) -1});+ checkV(20);+ godistance (20);+ checkV(80);|]+ }+ + +-- the complete graph of the part-testcases + ++dirgraph = mkEle startRunCp+ &-&+ split [ mkEle sbeByUeStoerCp,+ mkEle sbeByGKS1Cp,+ mkEle enterSBCp + ]+ &-&+ mkEle sendGK3Cp+ &-&+ mkEle (markCp "Mark_1")+ &-&+ mkEle checkVcodeCp+ &-&+ mkEle endLACp++++ ++ +main :: IO ()+main = do + let testcases = generate "# " teLATestset (TeLAVars 0) (L.pack . show) (dirGraph testgraph)+ printTestcases testcases+ let vizGraph = mkVizGraph (dirGraph testgraph)+ printTestgraph recordView1 vizGraph++
+ doc/examples/Te_LA2.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE QuasiQuotes, ExtendedDefaultRules, OverloadedStrings #-}++module Te_LA2 where -- exports everything, thus import only qualified!+++import TestExplode.TestExplode+import TestExplode.DirGraphCombine+import VizViews+import FinalIO+++import Text.InterpolatedString.Perl6 (qc)++import qualified Data.Text.Lazy as L+++docuinfo = TGDocuInfo { descForTex = [qc|+ Entering a Speed Rest with all possibilities,+ (checking the allowed Speed by driving faster:)+ possibilites:+ GK 3 in SBE (entering SBE with all possibilites)+ GK 3 in SB+ GK2 by GKS+ GK2 by Infill+ GK2 behind SB+ Bhf's LA by GKS+ Bhf's LA by Infill|],+ name="LA_1",+ descForNode = "Entering a Speed Rest\n\+ \with all possibilities",+ generic = True,+ toExpand =True+ }+++testgraph = Testgraph { dirGraph = dirgraph,+ docuInfo = docuinfo+ }+-- -------+-- Definition of the test data+-- -------+++data TeLACnf = + TeLACnf { allowedSpeed :: Int+ ,markName :: String+ }+ deriving (Show)+ +teLATestset = [ TeLACnf { allowedSpeed = v,+ markName = "InLA"+ }+ |+ v <- [5, 10, 15]+ ] ++data TeLAVars =+ TeLAVars { runnedDistance :: Int }++ +-- ------+-- Definition of the dirGraph:+-- -----++ +-- Parts of testcases (Casepart's)++-- Power Up++startRunCode :: TeLACnf -> TeLAVars -> L.Text+startRunCode cfg locals = [qc|+ switchOn();+ testTheUnit(ok);+ accelerateTo({(allowedSpeed cfg) -2});+|]++startRunCp = emptyCp + { shortDesc = "Start up and run",+ longDesc = "Switch the unit on\n Make functional test\n Accelerate below allowed speed",+ codeFkt = startRunCode+ }+ +-- SBE by GKS GK1++sbeByGKS1Code :: TeLACnf -> TeLAVars -> L.Text+sbeByGKS1Code cnf locals = [qc|+ sendGKS(1, \{"SBE" =>1, "Z"=>20, "VZ"=> 80\});+ goDistance(25);|]+ + +sbeByGKS1Cp = emptyCp+ { shortDesc = "Reach SBE with\n GK1: SBE, Z=20, VZ=80\n 5 m behind Z",+ longDesc = "Reach SBE with\n GK1: SBE, Z=20, VZ=80\n 5 m behind Z",+ codeFkt = sbeByGKS1Code+ }+-- SBe by end of Stoerfahrtweglaenge+ +sbeByUeStoerCode cfg locals = [qc|+ makeFue(1);+ godistance(6);+ makeFue(0);+ goDistance(1010);|]+ +sbeByUeStoerCp = emptyCp+ { shortDesc = "Ue-Stoer, Weg abfahren",+ longDesc = "Fue, No Fue, 1010 m ride",+ codeFkt = sbeByUeStoerCode+ }+ +-- receive GK3, enter LA++sendGK3code :: TeLACnf -> TeLAVars -> L.Text+sendGK3code cfg locals = [qc|+ sendGKS(3, "ZLA"=> 20, "VLA"=>{ fromIntegral( allowedSpeed cfg) / 5 }, "LLA" => 500 );+ godistance(20); |]+ +sendGK3vars cfg locals = TeLAVars 480 ++sendGK3Cp = emptyCp + { shortDesc ="GK3-LA erreichen,\n 50 m rest bis Ziel erreicht",+ longDesc = "GK3-LA erreichen,\n 50 m rest bis Ziel erreicht",+ codeFkt = sendGK3code,+ varFkt = sendGK3vars+ }+ +-- enter SB+enterSBcode :: TeLACnf -> TeLAVars -> L.Text+enterSBcode cfg locals = [qc|+ sendGKS(1, \{"Z"=> 3000\});+ godistance(10);|]++ +enterSBCp = emptyCp {+ shortDesc = "Enter Signal Run",+ longDesc = "Enter signal run",+ codeFkt = enterSBcode+ }+ +-- makeMark++makeMark = emptyCp {+ shortDesc = "Mark",+ longDesc ="Mark",+ codeFkt = \cfg locals -> [qc|+ setCheckMark({markName cfg});|]+ }+ +-- check V++checkVcodeCp = emptyCp {+ shortDesc = "VLA über- und wieder\nunterschreiten",+ longDesc = "VLA über- und wieder\nunterschreiten",+ codeFkt = \cfg locals -> [qc|+ testZBv({allowedSpeed cfg});|]+ }++-- Bis zum ende der LA fahren ++endLACp = emptyCp {+ shortDesc = "Aus LA fahren und V davor und danach prüfen",+ -- longDesc = "Aus LA fahren und V davor und danach prüfen",+ codeFkt = \cfg locals -> [qc|+ godistance ({(runnedDistance locals) -1});+ checkV(20);+ godistance (20);+ checkV(80);|]+ }+ + +-- the complete graph of the part-testcases + ++dirgraph = mkEle startRunCp+ &-&+ split [ mkEle sbeByUeStoerCp,+ mkEle sbeByGKS1Cp,+ mkEle enterSBCp + ]+ &-&+ mkEle sendGK3Cp+ &-&+ mkEle (markCp "Mark_1")+ &-&+ mkEle checkVcodeCp+ &-&+ mkEle endLACp++++ ++ +main :: IO ()+main = do + let testcases = generate "# " teLATestset (TeLAVars 0) (L.pack . show) (dirGraph testgraph)+ printTestcases testcases+ let vizGraph = mkVizGraph (dirGraph testgraph)+ printTestgraph recordView1 vizGraph++
+ doc/examples/VizViews.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}++{-|+Module : VizViews+Description : Defines the some different look of graphs for the module graphviz.+Copyright : (c) Hans-Jürgen Guth, 2014+License : LGPL+Maintainer : juergen.software@freea2a.de+Stability : experimental++Here is the look of the graphs from graphviz defined.+Feel free to add your own. For more information to the source code,+refer to the docu of the module graphviz.+-}++module VizViews (recordView1, defaultView) where++import TestExplode.TestExplode++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.PatriciaTree (Gr)+import Data.GraphViz+import Data.GraphViz.Attributes.Complete+import qualified Data.Text.Lazy as L+++-- | From the docu of GraphViz. Only numbers in the nodes.+-- But as a test it works.+defaultView :: (Graph gr) => gr nl el -> DotGraph Node+defaultView = graphToDot nonClusteredParams++-- | My own favorite view of the graph+recordView1 :: GraphvizParams Node (Maybe (CasepartInternal cnf locals), Maybe TGDocuInfo) + () + () + (Maybe (CasepartInternal cnf locals), Maybe TGDocuInfo)+recordView1 = nonClusteredParams { fmtNode = fmtNodeMy }++fmtNodeMy :: (Node, (Maybe (CasepartInternal cnf locals), Maybe TGDocuInfo)) + -> Attributes+fmtNodeMy (_, mcp) = case mcp of+ (Just cp, _) -> + let bgcolor = if cpTypeI cp == Mark+ then LightGoldenrod2 --YellowGreen+ else+ if condDescI cp == ""+ then LightGoldenrodYellow + else Yellow + in + let attrs = [ shape Record+ , style filled]+ in + if condDescI cp ==""+ then [Label (RecordLabel [FlipFields[ FieldLabel (shortDescI cp)+ ]+ ]+ ), fillColor bgcolor] + ++ attrs+ else [Label (RecordLabel [FlipFields[ FieldLabel (condDescI cp)+ , FieldLabel (shortDescI cp)+ ]+ ]+ ), fillColor bgcolor] + ++ attrs+ (Nothing, Nothing) -> + [ styles [filled, dotted]+ , fillColor LightGray+ , toLabel L.empty]+ (Nothing, Just di) -> -- testgraph that is not expanded+ [shape Record,+ styles [bold, filled],+ fillColor Orange,+ fontColor Blue,+ FontName (L.pack("Times-Italic")),+ -- change ".svg" if you use other extensions for the+ -- picture of the graph+ -- change "../subgraphs/", if you use another+ -- subdirectory for the subgraphs+ URL (L.pack("../subgraphs/" ++ name di ++ ".svg")), + Label (RecordLabel [FlipFields[ FieldLabel (L.pack ((name di) + ++ "\n" + ++ (descForNode di) ))+ ]+ ])]+
+ src/TestExplode/DirGraphCombine.hs view
@@ -0,0 +1,155 @@++{-|+Module : TestExplode.DirGraphCombine+Description : Evaluation of DirGraph's to FGL-Graphs, so that they can evaluated by the module graphviz.+Copyright : (c) Hans-Jürgen Guth, 2014+License : LGPL+Maintainer : juergen.software@freea2a.de+Stability : experimental++The Functions of this module enables you to generate FGL-Graphs for+the haskell module graphviz.+-}++module TestExplode.DirGraphCombine (mkVizGraph, mkGraphBeginEnd, VizGraph) where++import TestExplode.TestExplode -- (DirGraph(SimpleDG, Conc, Join, StructDG)+ -- , SplittedGraph(Split)+ -- , Testgraph(Testgraph)+ -- , TGDocuInfo(TGDocuInfo)+ -- )++import Data.Graph.Inductive.Graph+import Data.Graph.Inductive.PatriciaTree++import Control.Monad.State++++-- | Graph for Graphviz: a FGL-Graph+type VizGraph a = Gr (Maybe a, Maybe TGDocuInfo) () -- Gr is definied in PatriciaTree+++-- | The heart of this module: DirGraph to VizGraph.+-- Runs the state monad 'mkGraphBeginEnd'.+mkVizGraph :: DirGraph a -> VizGraph a+mkVizGraph dirGraph = fst . fst $ runState (mkGraphBeginEnd dirGraph) empty +++-- | the evaluate-function of the EDSL to generate a +-- VizGraph. Normally the function 'mkVizGraph' should be sufficent for the end-user.+-- The state is a 'VizGraph', that is used to apply the function +-- 'newNodes' to it, that gives one or more new nodes.+-- In this VizGraph the Nodes are simply added, edges are senseless and+-- not added.+-- The output is the resulting VizGraph and a tuple of the first Node+-- and the last Node (remember: a DirGraph has exactly one begin and one end).+mkGraphBeginEnd :: DirGraph a -> State (VizGraph a) (VizGraph a, (Node, Node))+mkGraphBeginEnd (SimpleDG x) =+ do+ stateGraph <- get+ let newNode1 = head $ newNodes 1 stateGraph+ put $ insNode (newNode1, (Just x, Nothing)) stateGraph+ let returnGraph = insNode (newNode1, (Just x, Nothing)) empty + return (returnGraph, (newNode1, newNode1))+ -- alternative: + -- state (+ -- \oldGraph ->+ -- let + -- newNode1 = head $ newNodes 1 oldGraph+ -- newGraph = insNode (newNode1, Just x) oldGraph+ -- returnGraph = insNode (newNode1, Just x) empty + -- in+ -- ((returnGraph, (newNode1, newNode1)), newGraph ) + -- ) ++mkGraphBeginEnd (Conc dirGraph1 dirGraph2) = + do + (graph1, (nid11,nid12)) <- mkGraphBeginEnd dirGraph1+ (graph2, (nid21,nid22)) <- mkGraphBeginEnd dirGraph2+ let bigGraph1 = addGraph graph1 graph2+ -- Verbindungskante einfuegen+ -- (hier koennte noch eine Reduzierung um + -- "Nothing"-Nodes hin, die nur erzeugt wurden,+ -- damit es 1 Anfang und 1 Ende eines gesplitteten+ -- Graphen gibt)+ let bigGraph2 = insEdge (nid12, nid21, ()) bigGraph1+ -- Ergebnis zuweisen:+ -- 2. alles zusammen+ return (bigGraph2, (nid11, nid22))+ +mkGraphBeginEnd (Join splittedGraph) = + do+ -- alle Graphen auswerten+ newGraphs <- mkSplittedGraph (splittedGraph)+ -- den status, d.h. die Menge aller Knoten + -- und aktuelle Cluster-Nummer holen+ currState1 <- get+ -- aufbauend auf dem Status 2 neue Knoten generieren+ let newNode1:newNode2:[] = newNodes 2 currState1+ -- nodes in den Status einfuegen,+ -- mehr muss mit dem Status nicht gemacht werden+ put $ (insNodes [(newNode1, (Nothing, Nothing)), (newNode2, (Nothing, Nothing))] currState1)+ -- nodes in den return-Graphen einfuegen+ let newGraph1 = insNodes [(newNode1, (Nothing, Nothing)), (newNode2, (Nothing, Nothing))] empty+ -- alle neuen Graphen in den return-Graphen einfuegen+ let newGraph2 = foldr (addGraph . fst) newGraph1 newGraphs+ -- neue Kanten erstellen+ let newBeginEdges = mkBeginNode newNode1 newGraphs+ let newEndEdges = mkEndNode newNode2 newGraphs+ -- neue Kanten einfuegen+ let newGraph3 = insEdges (newBeginEdges ++ newEndEdges) newGraph2+ -- fertig!+ return (newGraph3, (newNode1, newNode2)) + +mkGraphBeginEnd (StructDG tg) =+ case toExpand (docuInfo tg) of+ True -> mkGraphBeginEnd (dirGraph tg)+ False -> do + stateGraph <- get+ let newNode1 = head $ newNodes 1 stateGraph+ put $ insNode (newNode1, (Nothing, Just (docuInfo tg))) stateGraph+ let returnGraph = insNode (newNode1, (Nothing, Just (docuInfo tg))) empty + return (returnGraph, (newNode1, newNode1)) ++-- Ein SplittedGraph wird ausgewertet und als Liste zurueckgegeben +mkSplittedGraph :: SplittedGraph a -> State (VizGraph a) [(VizGraph a, (Node, Node))]+mkSplittedGraph (Split []) = return []+mkSplittedGraph (Split (x:xs)) =+ do+ newErg <- mkGraphBeginEnd x + newList <- mkSplittedGraph (Split xs)+ return (newErg : newList)+ + +-- Hilfsfunktion, um einen Knoten mit allen In- oder Outnodes zu verbinden+mkBeginNode :: Node -> [(VizGraph a, (Node, Node))] -> [(Node, Node, ())]+mkBeginNode node [] = []+mkBeginNode node ((_, (node1,node2)):xs) =+ (node, node1,()) : (mkBeginNode node xs)+ +-- Hilfsfunktion, um einen Knoten mit allen In- oder Outnodes zu verbinden+mkEndNode :: Node -> [(VizGraph a, (Node, Node))] -> [(Node, Node, ())]+mkEndNode node [] = []+mkEndNode node ((_, (node1,node2)):xs) =+ (node2, node,()) : (mkEndNode node xs)+++-- Hilfsfunktion, um zwei Graphen zu Einen (meist disjunkten) zu machen+-- precondition: different node-id's in bigGraph and smallGraph+addGraph :: Gr a b-> Gr a b -> Gr a b+addGraph bigGraph smallGraph =+ -- doesn't work, makes double edges+ -- let smallContexts = map (context smallGraph) (nodes smallGraph)+ -- bigContexts = map (context bigGraph) (nodes bigGraph)+ -- allContexts = smallContexts ++ bigContexts+ -- in+ -- buildGr allContexts+ -- Alternative:+ -- also doesn't work, makes other double edges+ -- foldr (&) bigGraph (map (context smallGraph) (nodes smallGraph))+ let biggerGraph = insNodes (labNodes smallGraph) bigGraph+ in+ insEdges (labEdges smallGraph) biggerGraph+ +
+ src/TestExplode/TestExplode.hs view
@@ -0,0 +1,464 @@+{-# LANGUAGE OverloadedStrings #-}+{-|+Module : TestExplode.TestExplode+Description : Definitions of part-testcases, graphs of them, and an evaluation function to generate complete testcases (strings).+Copyright : (c) Hans-Jürgen Guth, 2014+License : LGPL+Maintainer : juergen.software@freea2a.de+Stability : experimental++With this module you can define a graph of part-testcases+('Casepart') and evaluate this graph to a list of strings,+where every string is the concatenation of the code of the+part-testcases.+-}++module TestExplode.TestExplode (+ -- * Types+ Casepart(Casepart)+ , shortDesc+ , longDesc+ , condDesc+ , codeFkt+ , varFkt+ , condition+ , CasepartInternal(CasepartInternal)+ , shortDescI+ , longDescI+ , condDescI+ , codeFktI+ , conditionI+ , CPType(NormalCP, Mark)+ , cpType+ , cpTypeI+ , DirGraph(SimpleDG, Conc, Join, StructDG)+ , SplittedGraph(Split)+ , Testgraph(Testgraph)+ , dirGraph+ , docuInfo+ , TGDocuInfo(TGDocuInfo)+ , name+ , descForNode+ , descForTex+ , generic+ , toExpand+ , Expand (Expand, NotExpand, AsIs) + -- * Functions+ , generate+ , emptyCp+ , markCp+ , getSubGraphs + -- * Functions for generating 'DirGraph' s + -- The non-graphical-UI for the user.+ -- Call it a EDSL, if you like+ , mkEle+ , (&-&)+ , conc+ , split+ , mkGraph2Ele+ , mkGraph2Ele0+ -- * Conversion Functions+ , convertDirGraph+ , convertTestgraph + ) where+ +import Control.Monad.Writer +import qualified Data.Text.Lazy as L+import qualified Data.Sequence as S+import qualified Data.Foldable as DF ++-- | The part-testcase+data Casepart cnf -- the test data+ locals -- test hints, that are changed by a Casepart+ -- for example the state of a state machine+ -- or the time since start of the Testcase + = Casepart + { + -- | short description of the part-testcase,+ -- currently used a) at top of a testcase to show+ -- which path the generated testcase belongs to+ -- and b) in the visualised graph as node-label + shortDesc :: L.Text+ -- | long description of the part-testcase+ -- currently generated in front of the code of the+ -- part-testcase+ , longDesc :: L.Text+ -- | description of the condition, under which+ -- the part-testcase is valid (if not, the path with+ -- this part-testcase will not be generated)+ , condDesc :: L.Text+ -- | the actual code, which forms the part-testcase,+ -- dependent of the "configuration" (the "cnf" in + -- 'Casepart cnf locals'), which is the test-data, + -- and local variables, that are changed by a Casepart.+ , codeFkt :: cnf -> locals -> L.Text+ -- | The changes in the local variables+ , varFkt :: cnf -> locals -> locals+ -- | the condition under which the part-testcase+ -- is valid (if not, the path with+ -- this part-testcase will not be generated)+ , condition :: cnf -> locals -> Bool+ -- | Type of the Casepart, mainly (up to now only) for+ -- visualisation in the graph of Caseparts+ , cpType :: CPType+ }+ +-- | The part-testcase, internal format of 'Casepart', with a writer-monad as stringFkt +-- instead of the varFkt and the old stringFkt+data CasepartInternal cnf locals = CasepartInternal + { + shortDescI :: L.Text+ , longDescI :: L.Text+ , condDescI :: L.Text+ , codeFktI :: cnf -> locals -> Writer (S.Seq L.Text) locals+ , conditionI :: cnf -> locals -> Bool+ , cpTypeI :: CPType+ } + +-- | Types of Caseparts, mainly (up to now only) for+-- visualisation of the graph of Caseparts+data CPType = NormalCP | Mark+ deriving (Show, Eq)+ +-- | An empty testcase, all strings are "".+-- The condition is always 'True'.+-- Shall serve as an starting point for own definitions of+-- 'Casepart''s.+emptyCp = Casepart { shortDesc = ""+ , longDesc = ""+ , condDesc =""+ , codeFkt = \cnf locals -> ""+ , varFkt = \cnf locals -> locals + , condition = \cnf locals -> True+ , cpType = NormalCP+ } ++ +-- | Convenience Function to make easily a mark.+-- +markCp str = emptyCp { shortDesc = L.append "Mark: " str,+ longDesc = "Set a mark",+ codeFkt = \cnf locals -> L.concat[" setCheckMark(\"",+ str,+ "\");\n"],+ cpType = Mark+ } +-- | The heart of this module, the final function.+-- It takes configurations ('cnf' means testvalues),+-- that is a record of variables with a+-- value, a function that describes the "prelude" of one testcase (without+-- comment chars, which are later added) (a good starting value : the +-- 'show'-function of 'cnf', so that the used test-values are printed on top+-- of the testcase), the graph of testcases and returns +-- +-- voilá:+--+-- the +-- list of testcases, ready to printed out in seperate files and to run.+generate :: L.Text -- ^ how a text is coomented, ("# " or "-- ")+ -> [cnf] -- ^ a list of the testvalues+ -> locals -- ^ the initial value of the variables that the+ -- testcases change+ -> (cnf -> L.Text) -- ^ "prelude" of a testcase, i.e. 'show' of cnf+ -> DirGraph (CasepartInternal cnf locals) -- ^ the graph of caseparts+ -> [L.Text] -- ^ the final result: the list of testcases incl. comments+generate commentString cnfList locals cnfShow graph = + [L.concat[mkComment(L.concat[(cnfShow cnf),"\n", desc]) commentString,+ DF.fold $ snd $ runWriter (stringFkt cnf locals)+ ] | + cnf <- cnfList,+ -- Casepart stringFkt cond <- cpGetPaths graph,+ -- cond cnf] + --+ -- Does this work too? is independent of the + -- structure, uses record syntax+ let cpList = cpGetPaths commentString graph,+ (stringFkt, cond, desc) <- map getCodeAndConditionAndDesc cpList, + cond cnf locals]+ +-- | Internal help function, could be made more general for+-- arbitrary getter functions and number of getter functions +getCodeAndConditionAndDesc :: CasepartInternal a b -> + ((a -> b -> Writer (S.Seq L.Text) b), (a -> b ->Bool), L.Text)+getCodeAndConditionAndDesc cp = (codeFktI cp, conditionI cp, shortDescI cp)++-- | Internal function to comment the description with the commentString+mkComment :: L.Text -> L.Text -> L.Text+--mkComment str = let strNew = "# " ++ str+-- in+-- Utils.replace "\n" "\n# " str+mkComment str commentString = L.unlines $ map (L.append commentString ) (L.lines str)++ +-- Now all the functions for combinating Casepart's++-- | Directed graph with one end, self-invented definition+data DirGraph a = -- | Constructor for a node alone, + -- A node is a graph. + SimpleDG a | + -- | Constructor for one sub-graph after another+ Conc (DirGraph a) (DirGraph a) | + -- | Constructor for the "splitting" of graphs,+ -- comparable with an "if".+ -- The 'Join' makes the many ends and begins + -- to one end and one begin+ Join (SplittedGraph a) |+ -- | A graph with more attributes,+ -- importing of a 'Testgraph', only the part+ -- 'dirGraph' is used+ StructDG (Testgraph a)++-- | many disjunct graphs +-- Every part-graph has one end and one begin+data SplittedGraph a = Split [DirGraph a]++-- shorthand:+-- type CPDirGraph = DirGraph (Casepart cnf)++-- to build a directed graph:+-- at best:+-- ele1 conc ele2 conc (split [ele3, ele4, split [ele5, ele6], ele7]) conc ele8+--+-- this leads to::+-- eleN is a SimpleDG+-- conc can be infix: `conc`+-- the end of an split is a `join`++-- | Function to create a splitted graph +split :: [DirGraph a] -> DirGraph a+split x = Join (Split x)++-- | Function to craete a 'Conc' of two sub-graphs+conc :: DirGraph a -> DirGraph a -> DirGraph a+conc a b = Conc a b++-- | Infix synonym for 'conc'+(&-&) :: DirGraph a -> DirGraph a -> DirGraph a+a &-& b = Conc a b++-- | Function to create a node, Internal, with the CasepartInternal as 'a'+mkEleInt :: a -> DirGraph a+mkEleInt a = SimpleDG a++-- | Function to create a node, function for the user.+-- If longDesc = "", shortDesc is used as longDesc.+mkEle :: Casepart cnf locals -> DirGraph (CasepartInternal cnf locals)+mkEle cpUser = mkEleInt (CasepartInternal {shortDescI = shortDesc cpUser,+ longDescI = if longDesc cpUser == "" + then shortDesc cpUser+ else longDesc cpUser,+ condDescI = condDesc cpUser,+ codeFktI = mkLogging (codeFkt cpUser) (varFkt cpUser),+ conditionI = condition cpUser,+ cpTypeI = cpType cpUser+ })+ + +-- | Internal Function to build the monad-function as the new codeFkt+mkLogging :: (cnf -> locals -> L.Text) -- ^ the old codeFkt+ -> (cnf -> locals -> locals) -- ^ the change-function of the variables (old varFkt)+ -> (cnf -> locals -> Writer (S.Seq L.Text) locals) -- ^ the new codeFkt+mkLogging fText fVars = \cnf locs -> + let ret = fVars cnf locs+ in+ do tell $ S.singleton $ fText cnf locs+ return ret++++data Expand = Expand | NotExpand | AsIs++-- | Function to add a testgraph to a dirgraph+-- with converting-function f of the testdata ("cnfOld" resp. "cnfNew")+-- and a Boolean, that says, if the subgraph should be +-- expanded or not.+mkGraph2Ele :: (cnfNew -> cnfOld) -- ^ conversion function for the test-data-input of the casepart+ -> (localsInB -> localsInA) -- ^ conversion function for the + -- variables the testcases uses/changes (input-side)+ -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the + -- variables the testcases uses/changes (output-side)+ -- that is: how shall the variables look after the run + -- of the casepart? Dependant of the old value+ -- of the variables and the value of the variables after run+ -- of the imported testcase+ -> Expand -- ^ Shall this Graph in the documation expanded or not ?+ -> Testgraph (CasepartInternal cnfOld localsInA) -- ^ the Testgraph that shall be imported+ -> DirGraph (CasepartInternal cnfNew localsInB) -- ^ the imported Testgraph, now a DirGraph+ -- with the correct types+mkGraph2Ele fCnf fLocIn fLocOut expand tg = + let newTg = case expand of+ AsIs -> tg+ NotExpand -> tg {docuInfo=(docuInfo tg) {toExpand=False}}+ Expand -> tg {docuInfo=(docuInfo tg) {toExpand=True}}+ in + StructDG ( convertTestgraph fCnf fLocIn fLocOut newTg)+ + +-- | Function to add a testgraph to a dirgraph+-- without converting-function+mkGraph2Ele0 :: Testgraph a + -> DirGraph a+mkGraph2Ele0 tg = StructDG tg+++-- | The eval function of the EDSL. Evaluates a 'DirGraph' to the list +-- of all paths.+cpGetPaths :: L.Text -> DirGraph (CasepartInternal cnf locals ) -> [CasepartInternal cnf locals]+cpGetPaths commentString (SimpleDG cp) = + let lngDesc = longDescI cp+ cdFkt = codeFktI cp+ in + -- insert longDesc before codeFkt+ [cp{codeFktI = \cfg locals -> do + tell $ S.singleton "\n"+ tell $ S.singleton $ mkComment lngDesc commentString+ cdFkt cfg locals+ }] + +cpGetPaths commentString (Conc dirGraph1 dirGraph2) =+ let paths1 = cpGetPaths commentString dirGraph1+ paths2 = cpGetPaths commentString dirGraph2+ in + [CasepartInternal { + longDescI="" -- not relevant for combined part-testcases+ ,condDescI="" -- not relevant for combined part-testcases+ ,cpTypeI = NormalCP -- not relevant for combined part-testcases+ ,shortDescI = L.concat[shortDescI cp1,+ "\n and\n",+ shortDescI cp2]+ ,codeFktI = \cnf locals -> do + vars1 <- (codeFktI cp1) cnf locals+ (codeFktI cp2) cnf vars1+ ,conditionI = \cnf locals -> (((conditionI cp1) cnf locals) && ((conditionI cp2) cnf locals))} |+ cp1 <- paths1,+ cp2 <- paths2 ] -- jeder mit jedem+ +cpGetPaths commentString (StructDG tg) = cpGetPaths commentString (dirGraph tg)+ +cpGetPaths commentString (Join (Split paths )) = concat $ lcpGetPaths commentString (Split paths)++-- | the eval function of the EDSL for SplittedGraphs +lcpGetPaths :: L.Text -> SplittedGraph (CasepartInternal cnf locals) -> [[CasepartInternal cnf locals]]+lcpGetPaths commentString (Split paths) = map (cpGetPaths commentString) paths+++-- | Converts between Caseparts.+-- You need a interpreting from the target data-type to the+-- source data-type (not vice versa) +convertCasepart :: (cnfB -> cnfA) -- ^ conversion function for the test-data-input of the casepart+ -> (localsInB -> localsInA) -- ^ conversion function for the + -- variables the testcases uses/changes (input-side)+ -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the + -- variables the testcases uses/changes (output-side)+ -- that is: how shall the variables look after the run + -- of the casepart? Dependant of the old value+ -- of the variables and the value of the variables after run+ -- of the imported testcase+ -> CasepartInternal cnfA localsInA -- ^ the Casepart that shall be imported+ -> CasepartInternal cnfB localsInB -- ^ the imported Casepart with the correct types+convertCasepart fCnf fLocIn fLocOut cpa = + CasepartInternal { + codeFktI = \cnf locals -> do+ oldIn <- (codeFktI cpa) (fCnf cnf) (fLocIn locals)+ return $ fLocOut locals oldIn + ,+ conditionI = \cnf locals -> (conditionI cpa) (fCnf cnf) (fLocIn locals),+ shortDescI = shortDescI cpa,+ longDescI = longDescI cpa,+ condDescI = condDescI cpa,+ cpTypeI = cpTypeI cpa + }+ +-- | Converts a DirGraph, for example our testgraphs.+-- With that function you can import other testgraphs+-- with another set of variables. +-- You need a interpreting from the target data-type to the+-- source data-type (not vice versa) +convertDirGraph :: (cnfB->cnfA) -- ^ conversion function for the test-data-input of the casepart+ -> (localsInB -> localsInA) -- ^ conversion function for the + -- variables the testcases uses/changes (input-side)+ -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the + -- variables the testcases uses/changes (output-side)+ -- that is: how shall the variables look after the run + -- of the casepart? Dependant of the old value+ -- of the variables and the value of the variables after run+ -- of the imported testcase+ -> DirGraph (CasepartInternal cnfA localsInA) -- ^ the DirGraph that shall be imported+ -> DirGraph (CasepartInternal cnfB localsInB) -- ^ the imported DirGraph with the correct types+convertDirGraph f fLocIn fLocOut (SimpleDG cp) = SimpleDG (convertCasepart f fLocIn fLocOut cp)+convertDirGraph f fLocIn fLocOut (Conc dg1 dg2)= Conc (convertDirGraph f fLocIn fLocOut dg1)+ (convertDirGraph f fLocIn fLocOut dg2)+ +convertDirGraph f fLocIn fLocOut (Join splittedGraph) = + Join ( convertSplittedGraph f fLocIn fLocOut splittedGraph)+ +++-- | Converts a SplittedGraph+convertSplittedGraph :: (cnfB->cnfA)+ -> (localsInB -> localsInA)+ -> (localsInB -> localsInA -> localsInB) + -> SplittedGraph (CasepartInternal cnfA localsInA) + -> SplittedGraph (CasepartInternal cnfB localsInB)+convertSplittedGraph f fLocIn fLocOut (Split dirGraphs) =+ Split (map (convertDirGraph f fLocIn fLocOut) dirGraphs) + + +-- Extensions to the modules+-- for adding parts of testgraph / subgraphs++data TGDocuInfo = + TGDocuInfo { name :: String,+ descForNode :: String,+ descForTex :: String,+ generic :: Bool,+ toExpand :: Bool+ } ++data Testgraph a = + Testgraph { dirGraph :: DirGraph a,+ docuInfo :: TGDocuInfo+ }++-- | Converts a testgraph, necessary in order to add +-- a different testgraph ( with another type of configuration)+-- to a dirGraph+convertTestgraph :: (cnfB -> cnfA) -- ^ conversion function for the test-data-input of the casepart+ -> (localsInB -> localsInA) -- ^ conversion function for the + -- variables the testcases uses/changes (input-side)+ -> (localsInB -> localsInA -> localsInB) -- ^ conversion function for the + -- variables the testcases uses/changes (output-side)+ -- that is: how shall the variables look after the run + -- of the casepart? Dependant of the old value+ -- of the variables and the value of the variables after run+ -- of the imported testcase+ -> Testgraph (CasepartInternal cnfA localsInA) -- ^ the Testgraph that shall be imported+ -> Testgraph (CasepartInternal cnfB localsInB) -- ^ the imported Testgraph with the correct types +convertTestgraph f fLocIn fLocOut tg = tg { dirGraph = convertDirGraph f fLocIn fLocOut (dirGraph tg)} ++-- | Convenience function for the case, that the return value of an +-- embedded 'Casepart' shall have no effect. The old local+-- values keep unchanged.+emptyOut :: localsInA -> localsInB -> localsInA+emptyOut fromMaster fromEmbedded = fromMaster ++++-- | Looks for all embedded 'Testgraph' in a 'DirGraph',+-- double embedded 'Testgraph' (identified by the attribute 'name')+-- are ignored.+getSubGraphs :: DirGraph a -> [(String, Testgraph a)] -> [(String, Testgraph a)]+getSubGraphs (SimpleDG cp) resList = resList+getSubGraphs (Conc dirGraph1 dirGraph2) resList =+ let newResList1 = getSubGraphs dirGraph1 resList+ newResList2 = getSubGraphs dirGraph2 newResList1 + in + newResList2+getSubGraphs (Join (Split dirGraphs)) resList = foldr getSubGraphs resList dirGraphs+getSubGraphs (StructDG tg) resList= case (lookup (name (docuInfo tg)) resList) of+ Nothing -> let newResList = (name (docuInfo tg), tg):resList+ in + getSubGraphs(dirGraph tg) newResList+ Just _ -> resList++