We planned to upgrade GitLab and Mattermost to the latest version this Friday morning (early). You may experience some downtime!

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