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
......
This diff is collapsed.
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