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] ...@@ -23,7 +23,7 @@ generic genShow a :: !String !Bool !a ![String] -> [String]
generic gLess a :: a a -> Bool 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 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 show :: !a -> [String] | genShow{|*|} a
show1 :: !a -> String | genShow{|*|} a show1 :: !a -> String | genShow{|*|} a
......
...@@ -116,6 +116,7 @@ gLess{|EITHER|} fl fr (RIGHT x) (LEFT y) = False ...@@ -116,6 +116,7 @@ gLess{|EITHER|} fl fr (RIGHT x) (LEFT y) = False
gLess{|CONS|} f (CONS x) (CONS y) = f x y gLess{|CONS|} f (CONS x) (CONS y) = f x y
gLess{|OBJECT|} f (OBJECT x) (OBJECT 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{|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{|Int|} x y = x < y
gLess{|Char|} x y = x < y gLess{|Char|} x y = x < y
gLess{|Bool|} False y = y gLess{|Bool|} False y = y
......
...@@ -13,6 +13,7 @@ definition module Gast.StdProperty ...@@ -13,6 +13,7 @@ definition module Gast.StdProperty
import Gast.GenLibTest import Gast.GenLibTest
import Gast.Testable import Gast.Testable
from Testing.TestEvents import :: Relation
class (\/) infixr 2 a b :: !a b -> Property // Conditional or of arg1 and arg2 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 class (/\) infixr 3 a b :: !a b -> Property // Conditional and of arg1 and arg2
...@@ -27,9 +28,8 @@ instance \/ Property Bool ...@@ -27,9 +28,8 @@ instance \/ Property Bool
instance \/ Bool Property instance \/ Bool Property
instance \/ Property Property instance \/ Property Property
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|} a // shows values x and y if x =.= y yields False (=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x =.= y yields False
//check :: (a a -> Bool) -> a a -> Property | genShow{|*|} a check :: !(a a -> Bool) !Relation !a !a -> Property | genShow{|*|}, JSONEncode{|*|} a
check :: (a a -> Bool) !a !a -> Property | genShow{|*|} a
class (==>) infixr 1 b :: !b p -> Property | Testable p class (==>) infixr 1 b :: !b p -> Property | Testable p
......
...@@ -11,7 +11,7 @@ implementation module Gast.StdProperty ...@@ -11,7 +11,7 @@ implementation module Gast.StdProperty
pieter@cs.ru.nl pieter@cs.ru.nl
*/ */
import Gast.Testable, StdEnv import Gast.Testable, StdEnv, Testing.TestEvents, Text.JSON
from Math.Random import genRandInt from Math.Random import genRandInt
import System.OS import System.OS
...@@ -149,33 +149,20 @@ ForEach list f = Prop (forAll f list) ...@@ -149,33 +149,20 @@ ForEach list f = Prop (forAll f list)
(For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x (For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(For) p list = ForEach list p (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] (=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, JSONEncode{|*|} a
instance VOOR (->) (=.=) x y = check (==) Eq x y
where VOOR f l = map f l
:: PL a b = PL [a->b] affirm :: !(a a->Bool) !Relation a a .GenState !.Admin -> [Admin] | genShow{|*|}, JSONEncode{|*|} a
instance VOOR PL affirm op rel x y rs admin
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
| op x y | op x y
= evaluate True rs admin = evaluate True rs admin
= evaluate False rs = evaluate False rs
{admin {admin
& mes = ["\nnot (" & failedAssertions = [ExpectedRelation (toJSON x) rel (toJSON y) : admin.Admin.failedAssertions]
, mes = ["\nnot ("
:genShow{|*|} "" False x :genShow{|*|} "" False x
[ " ", thunk_name_to_string op, "{",thunk_to_module_name_string op,"} " [ " ", thunk_name_to_string op, "{",thunk_to_module_name_string op,"} "
: genShow{|*|} "" False y [")\n": admin.mes] : genShow{|*|} "" False y [")\n": admin.mes]
...@@ -201,7 +188,7 @@ label :: !l !p -> Property | Testable p & genShow{|*|} l ...@@ -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]}) 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 -> 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 :: !(Map (TypeName, RecFieldName) Int) !p -> Property | Testable p
limitNrOfRecFieldValues limits p = Prop (\rs r = evaluate p rs {Admin| r & recFieldValueNrLimits = limits}) limitNrOfRecFieldValues limits p = Prop (\rs r = evaluate p rs {Admin| r & recFieldValueNrLimits = limits})
......
...@@ -14,15 +14,19 @@ definition module Gast.Testable ...@@ -14,15 +14,19 @@ definition module Gast.Testable
import Gast.GenLibTest import Gast.GenLibTest
from Gast.StdProperty import ::Property // for instance of testable from Gast.StdProperty import ::Property // for instance of testable
import Gast.Gen import Gast.Gen
from Testing.TestEvents import :: CounterExample, :: FailedAssertion
from Text.JSON import :: JSONNode, generic JSONEncode
//--- basics --// //--- basics --//
:: Admin = :: Admin =
{ labels :: ![String] { labels :: ![String]
, args :: ![String] , args :: ![String]
, argsJSON :: ![JSONNode]
, name :: ![String] , name :: ![String]
, res :: !Result , res :: !Result
, mes :: ![String] , mes :: ![String]
, failedAssertions :: ![FailedAssertion]
, recFieldValueNrLimits :: !Map (TypeName, RecFieldName) Int //* Restricts the number of values generated for record fields , recFieldValueNrLimits :: !Map (TypeName, RecFieldName) Int //* Restricts the number of values generated for record fields
} }
:: Result = Undef | Rej | Pass | OK | CE :: Result = Undef | Rej | Pass | OK | CE
...@@ -35,7 +39,7 @@ instance == Result ...@@ -35,7 +39,7 @@ instance == Result
prop :: a -> Property | Testable a 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] class Testable a where evaluate :: !a GenState !Admin -> [Admin]
instance Testable Bool 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