diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,165 @@ + GNU LESSER GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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! + + + + + + + + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/TestExplode.cabal b/TestExplode.cabal new file mode 100644 --- /dev/null +++ b/TestExplode.cabal @@ -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 + diff --git a/doc/examples/Example1.hs b/doc/examples/Example1.hs new file mode 100644 --- /dev/null +++ b/doc/examples/Example1.hs @@ -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 diff --git a/doc/examples/FinalIO.hs b/doc/examples/FinalIO.hs new file mode 100644 --- /dev/null +++ b/doc/examples/FinalIO.hs @@ -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") + + diff --git a/doc/examples/Te23.hs b/doc/examples/Te23.hs new file mode 100644 --- /dev/null +++ b/doc/examples/Te23.hs @@ -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 + + diff --git a/doc/examples/Te52.hs b/doc/examples/Te52.hs new file mode 100644 --- /dev/null +++ b/doc/examples/Te52.hs @@ -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 + + diff --git a/doc/examples/Te_LA.hs b/doc/examples/Te_LA.hs new file mode 100644 --- /dev/null +++ b/doc/examples/Te_LA.hs @@ -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 + + diff --git a/doc/examples/Te_LA2.hs b/doc/examples/Te_LA2.hs new file mode 100644 --- /dev/null +++ b/doc/examples/Te_LA2.hs @@ -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 + + diff --git a/doc/examples/VizViews.hs b/doc/examples/VizViews.hs new file mode 100644 --- /dev/null +++ b/doc/examples/VizViews.hs @@ -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) )) + ] + ])] + diff --git a/src/TestExplode/DirGraphCombine.hs b/src/TestExplode/DirGraphCombine.hs new file mode 100644 --- /dev/null +++ b/src/TestExplode/DirGraphCombine.hs @@ -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 + + diff --git a/src/TestExplode/TestExplode.hs b/src/TestExplode/TestExplode.hs new file mode 100644 --- /dev/null +++ b/src/TestExplode/TestExplode.hs @@ -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 + +