Commit 2c098d30 authored by Steffen Michels's avatar Steffen Michels

add option to limit number of test data generated for specific record fields on property level

parent 2bb98569
......@@ -30,14 +30,16 @@ generic ggen a :: !GenState -> [a]
, skewr :: !Int
, recInfo :: !Map TypeName (Set TypeName)
, pairTree :: !PairTree
, recFieldValueNrLimits :: !Map (TypeName, RecFieldName) Int //* Restricts the number of values generated for record fields
}
:: TypeName :== String
:: RecFieldName :== String
:: PairTree = PTLeaf | PTNode PairTree Bool Bool PairTree
genState :: GenState
derive ggen Int, Bool, Real, Char, UNIT, PAIR, EITHER, CONS of gcd, OBJECT of gtd, FIELD, (,), (,,), (,,,), [], String, RECORD of grd
derive ggen Int, Bool, Real, Char, UNIT, PAIR, EITHER, CONS of gcd, OBJECT of gtd, FIELD of d, (,), (,,), (,,,), [], String, RECORD of grd
//derive ggen Int, Bool, Real, Char, UNIT, PAIR, EITHER, CONS, OBJECT, FIELD, (,), (,,), (,,,), [], String
maxint :: Int
......
......@@ -16,6 +16,7 @@ from Data.Set import :: Set
import qualified Data.Set as Set
from Data.Map import :: Map, instance Functor (Map k)
import qualified Data.Map as Map
from Data.Func import $
// -------
aStream :: RandomStream
......@@ -58,6 +59,7 @@ genState
, skewr = 3
, recInfo = 'Map'.newMap
, pairTree = PTLeaf
, recFieldValueNrLimits = 'Map'.newMap
}
// ================= skew generation ================= //
......@@ -181,7 +183,11 @@ where
recCount = recArgs typeName s.recInfo type
pairTree = genPairTree recCount grd.grd_arity
ggen{|FIELD|} f s = [FIELD fi \\ fi <- (f s)]
ggen{|FIELD of d|} f s = [FIELD fi \\ fi <- vals]
where
vals = case 'Map'.get (d.gfd_cons.grd_name, d.gfd_name) s.recFieldValueNrLimits of
Nothing -> f s
Just limit -> take limit $ f s
ggen{|String|} s = ["hello world!","Gast": rndStrings 0 aStream]
where
rndStrings 0 rnd = ["": rndStrings 1 rnd]
......
......@@ -49,6 +49,7 @@ ForEach :: ![x] !(x->p) -> Property | Testable p & TestArg x
classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
label :: !l !p -> Property | Testable p & genShow{|*|} l
name :: !n !p -> Property | Testable p & genShow{|*|} n
limitNrOfRecFieldValues :: !(Map (TypeName, RecFieldName) Int) !p -> Property | Testable p
instance ~ Bool
instance ~ Property
......@@ -103,7 +103,15 @@ where p rs r = [exists r [testAnalysis r (evaluate (f a) rs r)\\a <- l] MaxExist
Exists :: (x->p) -> Property | Testable p & TestArg x
Exists f = Prop p
where p genState r = [exists r [testAnalysis r (evaluate (f a) genState r)\\a <- generateAll genState] MaxExists]
where
p genState r =
[ exists
r
[ testAnalysis r (evaluate (f a) genState r)
\\ a <- generateAll {GenState| genState & recFieldValueNrLimits = r.Admin.recFieldValueNrLimits}
]
MaxExists
]
exists r [] n = {r & res = CE}
exists r _ 0 = {r & res = Undef}
exists _ [r=:{res}:x] n = case res of
......@@ -179,7 +187,12 @@ affirm op x y rs admin
(ForAndGen) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(ForAndGen) p list = Prop (evaluate p)
where evaluate f rs result = forAll f (list++generateAll genState) rs result
where
evaluate f rs result =
forAll f
(list++generateAll {GenState| genState & recFieldValueNrLimits = result.Admin.recFieldValueNrLimits})
rs
result
classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
classify c l p
......@@ -192,6 +205,9 @@ label l p = Prop (\rs r = evaluate p rs {r & labels = [show1 l:r.labels]})
name :: !n !p -> Property | Testable p & genShow{|*|} n
name n p = Prop (\rs r = evaluate p rs {r & name = [show1 n:r.name]})
limitNrOfRecFieldValues :: !(Map (TypeName, RecFieldName) Int) !p -> Property | Testable p
limitNrOfRecFieldValues limits p = Prop (\rs r = evaluate p rs {Admin| r & recFieldValueNrLimits = limits})
instance ~ Bool where ~ b = not b
instance ~ Result
......
......@@ -17,7 +17,13 @@ import Gast.Gen
//--- basics --//
:: Admin = {labels::![String], args::![String], name::![String], res::Result, mes::[String]}
:: Admin = { labels :: ![String]
, args :: ![String]
, name :: ![String]
, res :: Result
, mes :: [String]
, recFieldValueNrLimits :: !Map (TypeName, RecFieldName) Int //* Restricts the number of values generated for record fields
}
:: Result = Undef | Rej | Pass | OK | CE
newAdmin :: Admin
......
......@@ -12,12 +12,13 @@ implementation module Gast.Testable
*/
import StdEnv, Math.Random, Gast.GenLibTest, Gast.Gen
import qualified Data.Map as Map
derive gLess Result
instance == Result where (==) x y = x===y
newAdmin :: Admin
newAdmin = {res=Undef, labels=[], args=[], name=[], mes = []}
newAdmin = {res=Undef, labels=[], args=[], name=[], mes = [], recFieldValueNrLimits = 'Map'.newMap}
//class TestArg a | genShow{|*|}, ggen{|*|} a
......@@ -33,7 +34,10 @@ where evaluate (Prop p) genState result = p genState result
///instance Testable (a->b) | Testable b & genShow{|*|} a & ggen{|*|} a //TestArg a
instance Testable (a->b) | Testable b & genShow{|*|} a & ggen{|*|} a & TestArg a
where evaluate f genState admin = forAll f (generateAll genState) genState admin
where
evaluate f genState admin = forAll f (generateAll genState`) genState` admin
where
genState` = {GenState| genState & recFieldValueNrLimits = admin.Admin.recFieldValueNrLimits}
instance Testable [a] | Testable a
where
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment