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

Adapt to new Platform

parent d7641a8b
Pipeline #27823 failed with stage
in 37 seconds
......@@ -30,7 +30,7 @@ instance Testable (o1, o2, a) | Testable a
where
evaluate (_,_,p) g a = evaluate p g a
testname (_,_,p) = testname p
testmodule (_,_,p) = testmodule p
testlocation (_,_,p) = testlocation p
instance getOptions ([Testoption], a, b) where getOptions (opts,_,_) = opts
instance getPrintOptions (a, [PrintOption], b) where getPrintOptions (_,opts,_) = opts
......@@ -39,7 +39,7 @@ instance Testable ExposedProperty
where
evaluate (EP p) g a = evaluate p g a
testname (EP p) = testname p
testmodule (EP p) = testmodule p
testlocation (EP p) = testlocation p
instance getOptions ExposedProperty where getOptions (EP p) = getOptions p
......
......@@ -13,7 +13,7 @@ definition module Gast.StdProperty
import Gast.GenLibTest
import Gast.Testable
from Testing.TestEvents import :: Relation
from Testing.TestEvents import :: TestLocation, :: 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
......@@ -54,7 +54,7 @@ classify :: !Bool l !p -> Property | Testable p & genShow{|*|} l
label :: !l !p -> Property | Testable p & genShow{|*|} l
name :: !n !p -> Property | Testable p & toString n
module_and_name :: !String !n !p -> Property | Testable p & toString n
location_and_name :: !TestLocation !n !p -> Property | Testable p & toString n
/**
* Assigns a name to a testable property.
......
......@@ -27,12 +27,12 @@ import Gast.ThunkNames
instance ==> Bool
where
(==>) c p
| c = Prop ("Bool ==> " +++ testname p) (testmodule p) (evaluate p)
= Prop ("Bool ==> " +++ testname p) (testmodule p) (\rs r = [{r & res = Rej}])
| c = Prop ("Bool ==> " +++ testname p) (testlocation p) (evaluate p)
= Prop ("Bool ==> " +++ testname p) (testlocation p) (\rs r = [{r & res = Rej}])
instance ==> Property
where
(==>) c=:(Prop n _ _) p = Prop (n +++ " ==> " +++ testname p) (testmodule p) imp
(==>) c=:(Prop n _ _) p = Prop (n +++ " ==> " +++ testname p) (testlocation p) imp
where
imp rs r
# r1 = testAnalysis r (evaluate c rs r)
......@@ -214,8 +214,8 @@ label l p = Prop (testname p) Nothing (\rs r = evaluate p rs {r & labels = [show
name :: !n !p -> Property | Testable p & toString n
name n p = Prop (toString n) Nothing (\rs r -> evaluate p rs {r & namePath=[toString n:r.namePath]})
module_and_name :: !String !n !p -> Property | Testable p & toString n
module_and_name m n p = Prop (toString n) (Just m) \rs r -> evaluate p rs {r & namePath=[toString n:r.namePath]}
location_and_name :: !TestLocation !n !p -> Property | Testable p & toString n
location_and_name l n p = Prop (toString n) (Just l) \rs r -> evaluate p rs {r & namePath=[toString n:r.namePath]}
limitNrOfRecFieldValues :: !(Map (TypeName, RecFieldName) Int) !p -> Property | Testable p
limitNrOfRecFieldValues limits p = Prop (testname p) Nothing (\rs r = evaluate p rs {Admin| r & recFieldValueNrLimits = limits})
......
......@@ -15,7 +15,7 @@ from StdMaybe import :: Maybe(Nothing)
import Gast.GenLibTest
from Gast.StdProperty import ::Property // for instance of testable
import Gast.Gen
from Testing.TestEvents import :: CounterExample, :: FailedAssertion
from Testing.TestEvents import :: TestLocation, :: CounterExample, :: FailedAssertion
from Text.GenPrint import class PrintOutput, :: PrintState, generic gPrint
//--- basics --//
......@@ -35,18 +35,19 @@ newAdmin :: Admin
derive gLess Result
instance == Result
:: Property = Prop String (Maybe String) (GenState Admin -> [Admin])
:: Property = Prop String (Maybe TestLocation) (GenState Admin -> [Admin])
prop :: a -> Property | Testable a
class TestArg a | genShow{|*|}, ggen{|*|}, gPrint{|*|} a
class Testable a
where
evaluate :: !a GenState !Admin -> [Admin]
testname :: a -> String
testmodule :: a -> Maybe String
testmodule _ = Nothing
testlocation :: a -> Maybe TestLocation
testlocation _ = Nothing
instance Testable Bool
instance Testable Result
......@@ -117,8 +118,8 @@ generateAll :: !GenState -> [a] | ggen{|*|} a //& genType{|*|} a
}
:: GastEvent
= GE_TestStarted !(Maybe String) !String
| GE_TestFinished !(Maybe String) !String !TestsResult ![CounterExampleRes] ![(String,Int)]
= GE_TestStarted !(Maybe TestLocation) !String
| GE_TestFinished !(Maybe TestLocation) !String !TestsResult ![CounterExampleRes] ![(String,Int)]
| GE_CounterExample !CounterExampleRes
| GE_Tick !Int !Admin
......@@ -132,8 +133,8 @@ generateAll :: !GenState -> [a] | ggen{|*|} a //& genType{|*|} a
:: PrintConfig =
{ everyOutput :: Int Admin -> String
, counterExampleOutput :: CounterExampleRes -> String
, beforeStartOutput :: (Maybe String) String -> String
, resultOutput :: (Maybe String) String TestsResult [CounterExampleRes] [(String, Int)] -> String
, beforeStartOutput :: (Maybe TestLocation) String -> String
, resultOutput :: (Maybe TestLocation) String TestsResult [CounterExampleRes] [(String, Int)] -> String
}
printEvents :: PrintConfig [GastEvent] -> [String]
......
......@@ -52,7 +52,7 @@ instance Testable Property
where
evaluate (Prop _ _ p) genState result = p genState result
testname (Prop n _ _) = n
testmodule (Prop _ m _) = m
testlocation (Prop _ l _) = l
instance Testable (a->b) | Testable b & genShow{|*|} a & ggen{|*|} a & TestArg a
where
......@@ -60,18 +60,15 @@ where
where
genState` = {GenState| genState & recFieldValueNrLimits = admin.Admin.recFieldValueNrLimits}
testname f = thunk_name_to_string f
testmodule f = Just (thunk_to_module_name_string f)
testlocation f = Just {loc_module=Just (thunk_to_module_name_string f)}
instance Testable [a] | Testable a
where
evaluate list genState admin = diagonal [ evaluate x genState admin \\ x<-list ] // copy the genState
testname xs = "[" +++ join "," (map testname xs) +++ "]"
testmodule xs = case removeDup [testmodule x \\ x <- xs] of
[m] -> m
_ -> Nothing
prop :: a -> Property | Testable a
prop p = Prop (testname p) (testmodule p) (evaluate p)
prop p = Prop (testname p) (testlocation p) (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
......@@ -115,8 +112,8 @@ printEvents pc [ge:ges] = case s of
s -> [s:printEvents pc ges]
where
s = case ge of
GE_TestStarted m n -> pc.beforeStartOutput m n
GE_TestFinished m n r ces labels -> pc.resultOutput m n r ces labels
GE_TestStarted l n -> pc.beforeStartOutput l n
GE_TestFinished l n r ces labels -> pc.resultOutput l n r ces labels
GE_CounterExample ce -> pc.counterExampleOutput ce
GE_Tick n adm -> pc.everyOutput n adm
printEvents _ [] = []
......@@ -176,7 +173,7 @@ testEventsPrintConfig =
noCounterExampleOutput :: CounterExampleRes -> String
noCounterExampleOutput _ = ""
noBeforeOutput :: !(Maybe String) !String -> String
noBeforeOutput :: !(Maybe TestLocation) !String -> String
noBeforeOutput _ _ = ""
noEveryOutput :: !Int Admin -> String
......@@ -200,7 +197,7 @@ where
showFailedAssertion :: !(!FailedAssertion, !String, !String) -> [String]
showFailedAssertion (ExpectedRelation _ rel _, x, y) = ["not (", x, " ", toString rel, " ", y, ")\n"]
humanReadableResOutput :: Bool (Maybe String) String TestsResult [CounterExampleRes] [(String, Int)] -> String
humanReadableResOutput :: Bool (Maybe TestLocation) String TestsResult [CounterExampleRes] [(String, Int)] -> String
humanReadableResOutput addWhite _ name {maxTests, nRej, resultType} _ labels = withBlank $ showName True name +++ resStr
where
resStr = case resultType of
......@@ -240,18 +237,18 @@ where
showLabels 0 [(lab,n):rest] = ["\n",lab,": ",toString n:showLabels 0 rest]
showLabels ntests [(lab,n):rest] = ["\n",lab,": ",toString n," (",toString (toReal (n*100)/toReal ntests),"%)":showLabels ntests rest]
jsonEventStart :: !(Maybe String) !String -> String
jsonEventStart mod name = toString (toJSON {StartEvent | name=name, module_name=mod}) +++ "\n"
jsonEventStart :: !(Maybe TestLocation) !String -> String
jsonEventStart loc name = toString (toJSON {StartEvent | name=name, location=loc}) +++ "\n"
jsonEventEnd :: !(Maybe String) !String !TestsResult ![CounterExampleRes] ![(String, Int)] -> String
jsonEventEnd mod name res counterExamples labels = toString (toJSON endEvent) +++ "\n"
jsonEventEnd :: !(Maybe TestLocation) !String !TestsResult ![CounterExampleRes] ![(String, Int)] -> String
jsonEventEnd loc name res counterExamples labels = toString (toJSON endEvent) +++ "\n"
where
endEvent =
{ name = showName False name
, module_name = mod
, location = loc
, event = eventType
, message = concat
[ humanReadableResOutput False mod name res counterExamples labels
[ humanReadableResOutput False loc name res counterExamples labels
: map (humanReadableCEOutput False False) counterExamples
]
}
......@@ -354,14 +351,14 @@ testEventsn n rs p = printEvents testEventsPrintConfig $ testConfig rs { default
testConfig :: RandomStream Config p -> [GastEvent] | Testable p
testConfig rs {maxTests,maxArgs,fails,genState} p
# res = evaluate p genState newAdmin
= [GE_TestStarted (testmodule p) (testname p):analyse res maxTests maxArgs 0 0 0 [] []]
= [GE_TestStarted (testlocation p) (testname p):analyse res maxTests maxArgs 0 0 0 [] []]
where
analyse :: ![.Admin] !Int !Int !Int !Int !Int [CounterExampleRes] ![(String,Int)] -> [GastEvent]
analyse results nTests nArgs nRej nUnd nE counterExamples labels =
case analyse` results nTests nArgs nRej nUnd nE of
// testing of property finished
Just resType -> [GE_TestFinished
(testmodule p) (testname p)
(testlocation p) (testname p)
{maxTests = maxTests, nRej = nRej, resultType = resType}
counterExamples
labels]
......@@ -385,7 +382,7 @@ where
more | nE+1<fails
= analyse rest (nTests-1) (nArgs-1) nRej nUnd (nE+1) [counterExample: counterExamples] (admin res.labels labels)
= [GE_TestFinished
(testmodule p) (testname p)
(testlocation p) (testname p)
{ maxTests = maxTests
, nRej = nRej
, resultType = CounterExpls (nTests - 1) nUnd (nE + 1)
......
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