Commit ba8eed72 authored by Steffen Michels's avatar Steffen Michels

add fail reasons to test event output

parent 7db4fa3c
......@@ -23,7 +23,7 @@ generic genShow a :: !String !Bool !a ![String] -> [String]
generic gLess a :: a a -> Bool
derive genShow Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, OBJECT, CONS of {gcd_name,gcd_arity},RECORD of {grd_name}, FIELD of {gfd_name}, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,), (->), {}, {!}
derive gLess Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, OBJECT, CONS, FIELD, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)
derive gLess Int, Char, Bool, Real, String, UNIT, PAIR, EITHER, OBJECT, CONS, FIELD, RECORD, [], (,), (,,), (,,,), (,,,,), (,,,,,), (,,,,,,), (,,,,,,,), (,,,,,,,,), (,,,,,,,,,)
show :: !a -> [String] | genShow{|*|} a
show1 :: !a -> String | genShow{|*|} a
......
......@@ -116,6 +116,7 @@ gLess{|EITHER|} fl fr (RIGHT x) (LEFT y) = False
gLess{|CONS|} f (CONS x) (CONS y) = f x y
gLess{|OBJECT|} f (OBJECT x) (OBJECT y) = f x y
gLess{|FIELD|} f (FIELD x) (FIELD y) = f x y
gLess{|RECORD|} f (RECORD x) (RECORD y) = f x y
gLess{|Int|} x y = x < y
gLess{|Char|} x y = x < y
gLess{|Bool|} False y = y
......
......@@ -13,6 +13,7 @@ definition module Gast.StdProperty
import Gast.GenLibTest
import Gast.Testable
from Testing.TestEvents import :: Relation
class (\/) infixr 2 a b :: !a b -> Property // Conditional or of arg1 and arg2
class (/\) infixr 3 a b :: !a b -> Property // Conditional and of arg1 and arg2
......@@ -27,9 +28,8 @@ instance \/ Property Bool
instance \/ Bool Property
instance \/ Property Property
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|} a // shows values x and y if x =.= y yields False
//check :: (a a -> Bool) -> a a -> Property | genShow{|*|} a
check :: (a a -> Bool) !a !a -> Property | genShow{|*|} a
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x =.= y yields False
check :: !(a a -> Bool) !Relation !a !a -> Property | genShow{|*|}, JSONEncode{|*|} a
class (==>) infixr 1 b :: !b p -> Property | Testable p
......
......@@ -11,7 +11,7 @@ implementation module Gast.StdProperty
pieter@cs.ru.nl
*/
import Gast.Testable, StdEnv
import Gast.Testable, StdEnv, Testing.TestEvents, Text.JSON
from Math.Random import genRandInt
import System.OS
......@@ -149,33 +149,20 @@ ForEach list f = Prop (forAll f list)
(For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(For) p list = ForEach list p
// XXXXXXXXXXXXXXXXXXXXXXXXXX
check :: !(a a -> Bool) !Relation !a !a -> Property | genShow{|*|}, JSONEncode{|*|} a
check op rel x y = Prop (affirm op rel x y)
class (VOOR) infixl 0 t :: (t a b) [a] -> [b]
instance VOOR (->)
where VOOR f l = map f l
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, JSONEncode{|*|} a
(=.=) x y = check (==) Eq x y
:: PL a b = PL [a->b]
instance VOOR PL
where VOOR (PL fl) l = diagonal [map f l\\f<-fl] //[f x \\ f<-fl, x<-l]
//| Testable p & TestArg x
// XXXXXXXXXXXXXXXXXXXXXXXXXX
check :: (a a -> Bool) !a !a -> Property | genShow{|*|} a
check op x y = Prop (affirm op x y)
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|} a
(=.=) x y = check (==) x y
affirm :: (a a->Bool) a a .GenState !.Admin -> [Admin] | genShow{|*|} a
affirm op x y rs admin
affirm :: !(a a->Bool) !Relation a a .GenState !.Admin -> [Admin] | genShow{|*|}, JSONEncode{|*|} a
affirm op rel x y rs admin
| op x y
= evaluate True rs admin
= evaluate False rs
{admin
& mes = ["\nnot ("
& failedAssertions = [ExpectedRelation (toJSON x) rel (toJSON y) : admin.Admin.failedAssertions]
, mes = ["\nnot ("
:genShow{|*|} "" False x
[ " ", thunk_name_to_string op, "{",thunk_to_module_name_string op,"} "
: genShow{|*|} "" False y [")\n": admin.mes]
......@@ -201,7 +188,7 @@ label :: !l !p -> Property | Testable p & genShow{|*|} l
label l p = Prop (\rs r = evaluate p rs {r & labels = [show1 l:r.labels]})
name :: !n !p -> Property | Testable p & toString n
name n p = Prop (\rs r = evaluate p rs {r & name = [toString n:r.name]})
name n p = Prop (\rs r = evaluate p rs {Admin| r & name = [toString n:r.Admin.name]})
limitNrOfRecFieldValues :: !(Map (TypeName, RecFieldName) Int) !p -> Property | Testable p
limitNrOfRecFieldValues limits p = Prop (\rs r = evaluate p rs {Admin| r & recFieldValueNrLimits = limits})
......
......@@ -14,15 +14,19 @@ definition module Gast.Testable
import Gast.GenLibTest
from Gast.StdProperty import ::Property // for instance of testable
import Gast.Gen
from Testing.TestEvents import :: CounterExample, :: FailedAssertion
from Text.JSON import :: JSONNode, generic JSONEncode
//--- basics --//
:: Admin =
{ labels :: ![String]
, args :: ![String]
, argsJSON :: ![JSONNode]
, name :: ![String]
, res :: !Result
, mes :: ![String]
, failedAssertions :: ![FailedAssertion]
, recFieldValueNrLimits :: !Map (TypeName, RecFieldName) Int //* Restricts the number of values generated for record fields
}
:: Result = Undef | Rej | Pass | OK | CE
......@@ -35,7 +39,7 @@ instance == Result
prop :: a -> Property | Testable a
class TestArg a | genShow{|*|} a & ggen{|*|} a
class TestArg a | genShow{|*|} a & ggen{|*|} a & JSONEncode{|*|} a
class Testable a where evaluate :: !a GenState !Admin -> [Admin]
instance Testable Bool
......
......@@ -11,23 +11,26 @@ implementation module Gast.Testable
pieter@cs.ru.nl
*/
import StdEnv, Math.Random, Gast.GenLibTest, Gast.Gen, Text.JSON, Text, Text.Language
from Testing.TestEvents import :: EndEvent(..), :: EndEventType, :: StartEvent(..)
import qualified Testing.TestEvents as TestEvents
import StdEnv, Math.Random, Gast.GenLibTest, Gast.Gen, Text.JSON, Text, Text.Language, Testing.TestEvents, Data.Functor
from Data.Func import $
import qualified Data.Map as Map
from Data.List import instance Functor []
derive gLess Result
instance == Result where (==) x y = x===y
newAdmin :: Admin
newAdmin = {res=Undef, labels=[], args=[], name=[], mes = [], recFieldValueNrLimits = 'Map'.newMap}
newAdmin = { res=Undef, labels=[], args=[], argsJSON = [], name=[], mes = [], failedAssertions = []
, recFieldValueNrLimits = 'Map'.newMap
}
instance Testable Bool where
evaluate b genState result=:{Admin| args} = [{result & args = reverse args, res = if b OK CE}]
evaluate b genState result=:{Admin| args, argsJSON} =
[{result & args = reverse args, argsJSON = reverse argsJSON, res = if b OK CE}]
instance Testable Result where
evaluate r genState result=:{Admin| args} = [{result & args = reverse args, res = r}]
evaluate r genState result=:{Admin| args, argsJSON} =
[{result & args = reverse args, argsJSON = reverse argsJSON, res = r}]
instance Testable Property
where evaluate (Prop p) genState result = p genState result
......@@ -46,11 +49,12 @@ prop :: a -> Property | Testable a
prop p = Prop (evaluate p)
forAll :: !(a->b) ![a] GenState !Admin -> [Admin] | Testable b & TestArg a
forAll f [] genState r=:{Admin| args} = [{r & args = reverse args, res = OK}] // to handle empty sets of values
forAll f [] genState r=:{Admin| args, argsJSON} = [{r & args = reverse args, argsJSON = argsJSON, res = OK}] // to handle empty sets of values
forAll f list genState r = diagonal [apply f a genState r \\ a<-list ] // copy the genState
apply :: !(a->b) a GenState !Admin -> [Admin] | Testable b & TestArg a
apply f a genState r = evaluate (f a) genState {Admin| r & args = [show1 a:r.Admin.args]}
apply f a genState r =
evaluate (f a) genState {Admin| r & args = [show1 a:r.Admin.args], argsJSON = [toJSON a : r.argsJSON]}
diagonal :: ![[a]] -> [a]
diagonal list = f 1 2 list []
......@@ -76,9 +80,9 @@ derive bimap [], (,), (,,), (,,,), (,,,,), (,,,,,)
= { maxTests :: Int
, maxArgs :: Int
, everyOutput :: Int Admin [String] -> [String]
, counterExampleOutput :: CounterExample [String] -> [String]
, counterExampleOutput :: CounterExampleRes [String] -> [String]
, beforeStartOutput :: [String] -> [String]
, resultOutput :: TestsResult [CounterExample] [(!String, !Int)] [String] -> [String]
, resultOutput :: TestsResult [CounterExampleRes] [(!String, !Int)] [String] -> [String]
, fails :: Int
, randoms :: [Int]
, genState :: GenState
......@@ -96,21 +100,23 @@ derive bimap [], (,), (,,), (,,,), (,,,,), (,,,,,)
* The type of the combined result, together with information
* specific to that type of result.
*/
:: ResultType = Proof !Int //* Proof by exhaustive testing: nTests
| Passed !Int !Int !Int !Bool //* Passed test: maxArgs, nTests, nUnd, all possible args generated?
| CounterExamples !Int !Int !Int //* Counterexamples found: nTests nUnd nCounterExamples
| Undefined !Int //* Undefined result: nUnd
| NoTests !Int !Int !Int //* No tests performed: maxArgs nTests nUnd
:: ResultType = Proof !Int //* Proof by exhaustive testing: nTests
| PassedTest !Int !Int !Int !Bool //* Passed test: maxArgs, nTests, nUnd, all possible args generated?
| CounterExpls !Int !Int !Int //* Counterexamples found: nTests nUnd nCounterExamples
| Undefined !Int //* Undefined result: nUnd
| NoTests !Int !Int !Int //* No tests performed: maxArgs nTests nUnd
/**
* A counter examples.
* A counter example.
*/
:: CounterExample = { maxTests :: !Int //* Maximal number of tests for run in which counter example is found
, nTests :: !Int //* maxTests MINUS number of test at which counter example is found
, nE :: !Int //* Number of counter example
, args :: ![String] //* Arguments used for test
, name :: ![String] //* Name of property
}
:: CounterExampleRes =
{ maxTests :: !Int //* Maximal number of tests for run in which counter example is found
, nTests :: !Int //* maxTests MINUS number of test at which counter example is found
, nE :: !Int //* Number of counter example
, args :: ![String] //* Arguments used for test
, name :: ![String] //* Name of property
, failReason :: !CounterExample //* Structured reason for why the test fails
}
verboseConfig
= { maxTests = NrOfTest
......@@ -197,7 +203,7 @@ animate2 n r c
= ["\r \r",toString n," ":c]
= c
noCounterExampleOutput :: CounterExample [String] -> [String]
noCounterExampleOutput :: CounterExampleRes [String] -> [String]
noCounterExampleOutput _ acc = acc
noBeforeOutput :: ![String] -> [String]
......@@ -205,7 +211,7 @@ noBeforeOutput _ = []
noEveryOutput _ _ c = ["":c] // FIXME: empty string required to prevent stack overflow, why?
humanReadableCEOutput :: CounterExample [String] -> [String]
humanReadableCEOutput :: CounterExampleRes [String] -> [String]
humanReadableCEOutput {maxTests, nTests, nE, args, name} acc =
showName True
name
......@@ -217,7 +223,7 @@ humanReadableCEOutput {maxTests, nTests, nE, args, name} acc =
: showArgs args ["\n":acc]
]
humanReadableResOutput :: Bool TestsResult [CounterExample] [(String, Int)] [String] -> [String]
humanReadableResOutput :: Bool TestsResult [CounterExampleRes] [(String, Int)] [String] -> [String]
humanReadableResOutput addWhite {maxTests, nRej, resultType} _ labels name = withBlank $ showName True name resStr
where
resStr = case resultType of
......@@ -225,14 +231,14 @@ where
where
msgStr | nRej == 0 = "success for all arguments"
| otherwise = "success for all non-rejected arguments"
Passed maxArgs nTests nUnd allArgsGenerated -> [msgStr: conclude addWhite nTests nUnd labels]
PassedTest maxArgs nTests nUnd allArgsGenerated -> [msgStr: conclude addWhite nTests nUnd labels]
where
msgStr | allArgsGenerated = "Passed: success for arguments"
| nTests == 0 = "Passed"
| otherwise = concat ["Passed: maximum number of arguments (",toString maxArgs,") generated"]
CounterExamples nTests nUnd nE -> [ pluralisen English nE "counterexample"," found"
: conclude addWhite nTests nUnd labels
]
CounterExpls nTests nUnd nE -> [ pluralisen English nE "counterexample"," found"
: conclude addWhite nTests nUnd labels
]
Undefined nUnd -> [ "Undefined: no success nor counterexample found, all tests rejected or undefined"
: conclude addWhite maxTests nUnd labels
]
......@@ -267,20 +273,23 @@ where
jsonEventStart :: ![String] -> [String]
jsonEventStart name = [toString $ toJSON {StartEvent | name = concat $ showName False name []}, "\n"]
jsonEventEnd :: TestsResult [CounterExample] [(String, Int)] [String] -> [String]
jsonEventEnd :: TestsResult [CounterExampleRes] [(String, Int)] [String] -> [String]
jsonEventEnd res counterExamples labels name = [toString (toJSON endEvent) +++ "\n"]
where
endEvent = { name = concat $ showName False name []
, event = eventType
, message = concat $ foldl (flip humanReadableCEOutput) (humanReadableResOutput False res counterExamples labels []) counterExamples
, message = concat $ foldl (flip humanReadableCEOutput)
(humanReadableResOutput False res counterExamples labels [])
counterExamples
}
eventType = case res.resultType of
Proof _ -> 'TestEvents'.Passed
Passed _ _ _ _ -> 'TestEvents'.Passed
CounterExamples _ _ _ -> 'TestEvents'.Failed
Undefined _ -> 'TestEvents'.Failed
NoTests _ _ _ -> 'TestEvents'.Failed
Proof _ -> Passed
PassedTest _ _ _ _ -> Passed
CounterExpls _ _ _ -> Failed $ Just $ CounterExamples $
(\ce -> ce.CounterExampleRes.failReason) <$> counterExamples
Undefined _ -> Failed Nothing
NoTests _ _ _ -> Failed Nothing
showName :: Bool [String] [String] -> [String]
showName _ [] c = c
......@@ -384,7 +393,7 @@ testConfig rs {maxTests,maxArgs,everyOutput,counterExampleOutput,beforeStartOutp
# res = evaluate p genState newAdmin
= [concat $ beforeStartOutput (hd res).Admin.name : analyse res maxTests maxArgs 0 0 0 [] [] []]
where
analyse :: ![.Admin] !Int !Int !Int !Int !Int [CounterExample] ![(String,Int)] ![String] -> [String]
analyse :: ![.Admin] !Int !Int !Int !Int !Int [CounterExampleRes] ![(String,Int)] ![String] -> [String]
analyse results nTests nArgs nRej nUnd nE counterExamples labels name =
case analyse` results nTests nArgs nRej nUnd nE of
// testing of property finished
......@@ -396,19 +405,22 @@ where
// continue with testing property
Nothing ->
let [res:rest] = results in
//everyOutput (maxTests-nTests+1) res
everyOutput (maxTests-nTests+1) res
( case res.res of
OK = analyse rest (nTests-1) (nArgs-1) nRej nUnd nE
counterExamples (admin res.labels labels) res.Admin.name
Pass = analyse rest (nTests-1) (nArgs-1) nRej nUnd nE
counterExamples (admin res.labels labels) res.Admin.name // NOT YET CORRECT ?
CE = counterExampleOutput counterExample more
CE = counterExampleOutput counterExample more
where
counterExample = { maxTests = maxTests
, nTests = nTests
, nE = nE
, args = res.Admin.args
, name = res.Admin.name
counterExample = { maxTests = maxTests
, nTests = nTests
, nE = nE
, args = res.Admin.args
, name = res.Admin.name
, failReason = { counterExample = res.argsJSON
, failedAssertions = res.Admin.failedAssertions
}
}
more | nE+1<fails
......@@ -417,7 +429,7 @@ where
= resultOutput
{ maxTests = maxTests
, nRej = nRej
, resultType = CounterExamples (nTests - 1) nUnd (nE + 1)
, resultType = CounterExpls (nTests - 1) nUnd (nE + 1)
}
[counterExample: counterExamples]
(admin res.labels labels)
......@@ -432,14 +444,14 @@ where
analyse` [] ntests nargs nrej 0 0 = Just $ Proof ntests
analyse` [] ntests nargs nrej nund 0
| ntests==maxTests = Just $ Undefined nund
| otherwise = Just $ Passed maxArgs ntests nund True
analyse` [] ntests nargs nrej nund ne = Just $ CounterExamples ntests nund ne
analyse` _ 0 nargs nrej nund 0 = Just $ Passed maxArgs 0 nund False
analyse` _ 0 nargs nrej nund ne = Just $ CounterExamples 0 nund ne
| otherwise = Just $ PassedTest maxArgs ntests nund True
analyse` [] ntests nargs nrej nund ne = Just $ CounterExpls ntests nund ne
analyse` _ 0 nargs nrej nund 0 = Just $ PassedTest maxArgs 0 nund False
analyse` _ 0 nargs nrej nund ne = Just $ CounterExpls 0 nund ne
analyse` _ ntests 0 nrej nund 0
| ntests == maxTests = Just $ NoTests maxArgs ntests nund
= Just $ Passed maxArgs ntests nund False
analyse` _ ntests 0 nrej nund ne = Just $ CounterExamples ntests nund ne
= Just $ PassedTest maxArgs ntests nund False
analyse` _ ntests 0 nrej nund ne = Just $ CounterExpls ntests nund ne
analyse` _ _ _ _ _ _ = Nothing
admin :: ![String] ![(String,Int)] -> [(String,Int)]
......
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