Commit bc45a349 authored by Camil Staps's avatar Camil Staps 🍃

Merge branch 'clean-test-19' into 'master'

Update for clean-platform!167

See merge request !20
parents c394c76d 9fa79073
Pipeline #12589 failed with stage
in 30 seconds
......@@ -12,4 +12,4 @@ definition module Gast
import Math.Random, Data.GenEq
import Gast.Gen, Gast.GenLibTest, Gast.Testable, Gast.StdProperty, Gast.ConfSM
class Gast a | ggen{|*|}, genShow{|*|}, JSONEncode{|*|} a
class Gast a | ggen{|*|}, genShow{|*|}, gPrint{|*|} a
......@@ -28,12 +28,12 @@ instance \/ Property Bool
instance \/ Bool Property
instance \/ Property Property
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x == y yields False
(<.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x < y yields False
(<=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x <= y yields False
(>.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x > y yields False
(>=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a // shows values x and y if x >= y yields False
check :: !(a b -> Bool) !a !b -> Property | genShow{|*|}, JSONEncode{|*|} a & genShow{|*|}, JSONEncode{|*|} b
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, gPrint{|*|} a // shows values x and y if x == y yields False
(<.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a // shows values x and y if x < y yields False
(<=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a // shows values x and y if x <= y yields False
(>.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a // shows values x and y if x > y yields False
(>=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a // shows values x and y if x >= y yields False
check :: !(a b -> Bool) !a !b -> Property | genShow{|*|}, gPrint{|*|} a & genShow{|*|}, gPrint{|*|} b
class (==>) infixr 1 b :: !b p -> Property | Testable p
......@@ -71,4 +71,4 @@ limitNrOfRecFieldValues :: !(Map (TypeName, RecFieldName) Int) !p -> Property |
instance ~ Bool
instance ~ Property
approxEqual :: !a !a !a -> Property | abs, Ord, -, genShow{|*|}, JSONEncode{|*|} a
approxEqual :: !a !a !a -> Property | abs, Ord, -, genShow{|*|}, gPrint{|*|} a
......@@ -18,7 +18,7 @@ from Math.Random import genRandInt
import System.OS
import Testing.TestEvents
import Text
import Text.GenJSON
import Text.GenPrint
import Gast.Testable
import Gast.ThunkNames
......@@ -157,35 +157,35 @@ ForEach list f = Prop ("ForEach " +++ thunk_name_to_string list +++ " " +++ thun
(For) infixl 0 :: !(x->p) ![x] -> Property | Testable p & TestArg x
(For) p list = ForEach list p
check :: !(a b -> Bool) !a !b -> Property | genShow{|*|}, JSONEncode{|*|} a & genShow{|*|}, JSONEncode{|*|} b
check :: !(a b -> Bool) !a !b -> Property | genShow{|*|}, gPrint{|*|} a & genShow{|*|}, gPrint{|*|} b
check op x y = Prop name (\gs a -> affirm op (Other relName) x y gs {a & namePath=[name:a.namePath]})
where
name = thunk_name_to_string op
relName = concat [name, "{", thunk_to_module_name_string op, "}"]
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, JSONEncode{|*|} a
(=.=) infix 4 :: !a !a -> Property | Eq, genShow{|*|}, gPrint{|*|} a
(=.=) x y = Prop "=.=" (affirm (==) Eq x y)
(<.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a
(<.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a
(<.) x y = Prop "<." (affirm (<) Lt x y)
(<=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a
(<=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a
(<=.) x y = Prop "<=." (affirm (<=) Le x y)
(>.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a
(>.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a
(>.) x y = Prop ">." (affirm (>) Gt x y)
(>=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, JSONEncode{|*|} a
(>=.) infix 4 :: !a !a -> Property | Ord, genShow{|*|}, gPrint{|*|} a
(>=.) x y = Prop ">=." (affirm (>=) Ge x y)
affirm :: !(a b->Bool) !Relation a b .GenState !.Admin -> [Admin] | genShow{|*|}, JSONEncode{|*|} a & genShow{|*|}, JSONEncode{|*|} b
affirm :: !(a b->Bool) !Relation a b .GenState !.Admin -> [Admin] | genShow{|*|}, gPrint{|*|} a & genShow{|*|}, gPrint{|*|} b
affirm op rel x y rs admin
| op x y = evaluate True rs admin
| otherwise = evaluate
False
rs
{ Admin | admin
& failedAssertions = [ ( ExpectedRelation (toJSON x) rel (toJSON y)
& failedAssertions = [ ( ExpectedRelation (GPrint (printToString x)) rel (GPrint (printToString y))
, concat $ genShow{|*|} "" False x []
, concat $ genShow{|*|} "" False y []
)
......@@ -229,7 +229,7 @@ where
instance ~ Property
where ~ (Prop n p) = Prop ("~" +++ n) (\rs r = let r` = testAnalysis r (p rs r) in [{r` & res = ~r`.res}])
approxEqual :: !a !a !a -> Property | abs, Ord, -, genShow{|*|}, JSONEncode{|*|} a
approxEqual :: !a !a !a -> Property | abs, Ord, -, genShow{|*|}, gPrint{|*|} a
approxEqual err x y = Prop "approximately equals"
(affirm (\x y -> abs (x - y) <= err)
(Other $ concat ["approximately equals (error = ", toString $ toJSON err, ")"]) x y)
(Other $ concat ["approximately equals (error = ", printToString err, ")"]) x y)
......@@ -15,14 +15,14 @@ import Gast.GenLibTest
from Gast.StdProperty import ::Property // for instance of testable
import Gast.Gen
from Testing.TestEvents import :: CounterExample, :: FailedAssertion
from Text.GenJSON import :: JSONNode, generic JSONEncode
from Text.GenPrint import class PrintOutput, :: PrintState, generic gPrint
//--- basics --//
:: Admin =
{ labels :: ![String]
, args :: ![String]
, argsJSON :: ![JSONNode]
, argsRepresentation :: ![String]
, namePath :: ![String]
, res :: !Result
, failedAssertions :: ![(!FailedAssertion, !String, !String)] //* Failed assertion & string representation of args
......@@ -38,7 +38,7 @@ instance == Result
prop :: a -> Property | Testable a
class TestArg a | genShow{|*|} a & ggen{|*|} a & JSONEncode{|*|} a
class TestArg a | genShow{|*|}, ggen{|*|}, gPrint{|*|} a
class Testable a
where
evaluate :: !a GenState !Admin -> [Admin]
......@@ -102,13 +102,13 @@ generateAll :: !GenState -> [a] | ggen{|*|} a //& genType{|*|} a
* A counter example.
*/
:: 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 (string representation)
, argsJSON :: ![JSONNode] //* Arguments used for test (JSON encoding)
, name :: !String //* Name of property
, failedAssertions :: ![(!FailedAssertion, !String, !String)] //* Failed assertions leading to counter example & string representation of arguments
{ 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 (string representation)
, argsRepresentation :: ![String] //* Arguments used for test ({{`gPrint`}} encoding)
, name :: !String //* Name of property
, failedAssertions :: ![(!FailedAssertion, !String, !String)] //* Failed assertions leading to counter example & string representation of arguments
}
:: GastEvent
......
......@@ -21,6 +21,7 @@ import Math.Random
import Testing.TestEvents
import Text
import Text.GenJSON
import Text.GenPrint
import Text.Language
import Gast.Gen
......@@ -31,19 +32,19 @@ derive gLess Result
instance == Result where (==) x y = x===y
newAdmin :: Admin
newAdmin = { res=Undef, labels=[], args=[], argsJSON = [], failedAssertions = []
newAdmin = { res=Undef, labels=[], args=[], argsRepresentation = [], failedAssertions = []
, namePath = []
, recFieldValueNrLimits = 'Map'.newMap
}
instance Testable Bool where
evaluate b genState result=:{Admin| args, argsJSON} =
[{result & args = reverse args, argsJSON = reverse argsJSON, res = if b OK CE}]
evaluate b genState result=:{Admin| args, argsRepresentation} =
[{result & args = reverse args, argsRepresentation = reverse argsRepresentation, res = if b OK CE}]
testname b = "Bool"
instance Testable Result where
evaluate r genState result=:{Admin| args, argsJSON} =
[{result & args = reverse args, argsJSON = reverse argsJSON, res = r}]
evaluate r genState result=:{Admin| args, argsRepresentation} =
[{result & args = reverse args, argsRepresentation = reverse argsRepresentation, res = r}]
testname r = "Result"
instance Testable Property
......@@ -67,12 +68,12 @@ prop :: a -> Property | Testable a
prop p = Prop (testname p) (evaluate p)
forAll :: !(a->b) ![a] GenState !Admin -> [Admin] | Testable b & TestArg a
forAll f [] genState r=:{Admin| args, argsJSON} = [{r & args = reverse args, argsJSON = argsJSON, res = OK}] // to handle empty sets of values
forAll f [] genState r=:{Admin| args} = [{r & args = reverse args, 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], argsJSON = [toJSON a : r.Admin.argsJSON]}
evaluate (f a) genState {Admin| r & args = [show1 a:r.Admin.args], argsRepresentation = [printToString a : r.Admin.argsRepresentation]}
diagonal :: ![[a]] -> [a]
diagonal list = f 1 2 list []
......@@ -253,7 +254,7 @@ where
PassedTest _ _ _ _ -> Passed
CounterExpls _ _ _ -> Failed $ Just $ CounterExamples $
(\ce ->
{ counterExample = ce.CounterExampleRes.argsJSON
{ counterExample = map GPrint ce.CounterExampleRes.argsRepresentation
, failedAssertions = fst3 <$> ce.CounterExampleRes.failedAssertions
}
) <$> counterExamples
......@@ -365,13 +366,13 @@ where
CE -> [GE_CounterExample counterExample:more]
with
counterExample =
{ maxTests = maxTests
, nTests = nTests
, nE = nE
, args = res.Admin.args
, argsJSON = res.Admin.argsJSON
, name = let n = testname p in join "." [n:dropWhile ((==) n) (reverse res.namePath)]
, failedAssertions = res.Admin.failedAssertions
{ maxTests = maxTests
, nTests = nTests
, nE = nE
, args = res.Admin.args
, argsRepresentation = res.Admin.argsRepresentation
, name = let n = testname p in join "." [n:dropWhile ((==) n) (reverse res.namePath)]
, failedAssertions = res.Admin.failedAssertions
}
more | nE+1<fails
= analyse rest (nTests-1) (nArgs-1) nRej nUnd (nE+1) [counterExample: counterExamples] (admin res.labels labels)
......
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