{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Foundation.Check.Main
( defaultMain
) where
import Basement.Imports
import Basement.IntegralConv
import Basement.Cast (cast)
import Basement.Bounded
import Basement.Types.OffsetSize
import qualified Basement.Terminal.ANSI as ANSI
import qualified Basement.Terminal as Terminal
import Foundation.Collection
import Foundation.Numerical
import Foundation.IO.Terminal
import Foundation.Check (iterateProperty)
import Foundation.Check.Gen
import Foundation.Check.Property
import Foundation.Check.Config
import Foundation.Check.Types
import Foundation.List.DList
import Foundation.Random
import Foundation.Monad
import Foundation.Monad.State
import Data.Maybe (catMaybes)
nbFail :: TestResult -> HasFailures
nbFail :: TestResult -> CountOf TestResult
nbFail (PropertyResult Escape
_ CountOf TestResult
_ (PropertyFailed Escape
_)) = CountOf TestResult
1
nbFail (PropertyResult Escape
_ CountOf TestResult
_ PropertyResult
PropertySuccess) = CountOf TestResult
0
nbFail (GroupResult Escape
_ CountOf TestResult
t CountOf TestResult
_ [TestResult]
_) = CountOf TestResult
t
nbTests :: TestResult -> CountOf TestResult
nbTests :: TestResult -> CountOf TestResult
nbTests (PropertyResult Escape
_ CountOf TestResult
t PropertyResult
_) = CountOf TestResult
t
nbTests (GroupResult Escape
_ CountOf TestResult
_ CountOf TestResult
t [TestResult]
_) = CountOf TestResult
t
data TestState = TestState
{ TestState -> Config
config :: !Config
, TestState -> Word64
getSeed :: !Seed
, TestState -> CountOf Char
indent :: !(CountOf Char)
, TestState -> Word
testPassed :: !Word
, TestState -> Word
testFailed :: !Word
, TestState -> DList Escape
testPath :: !(DList String)
}
newState :: Config -> Seed -> TestState
newState :: Config -> Word64 -> TestState
newState Config
cfg Word64
initSeed = TestState :: Config
-> Word64
-> CountOf Char
-> Word
-> Word
-> DList Escape
-> TestState
TestState
{ testPath :: DList Escape
testPath = DList Escape
forall a. Monoid a => a
mempty
, testPassed :: Word
testPassed = Word
0
, testFailed :: Word
testFailed = Word
0
, indent :: CountOf Char
indent = CountOf Char
0
, getSeed :: Word64
getSeed = Word64
initSeed
, config :: Config
config = Config
cfg
}
filterTestMatching :: Config -> Test -> Maybe Test
filterTestMatching :: Config -> Test -> Maybe Test
filterTestMatching Config
cfg Test
testRoot
| [Escape] -> Bool
forall c. Collection c => c -> Bool
null (Config -> [Escape]
testNameMatch Config
cfg) = Test -> Maybe Test
forall a. a -> Maybe a
Just Test
testRoot
| Bool
otherwise = [Escape] -> Test -> Maybe Test
testFilter [] Test
testRoot
where
match :: [Escape] -> Escape -> Bool
match [Escape]
acc Escape
s = [Bool] -> Bool
forall col. (Collection col, Element col ~ Bool) => col -> Bool
or ((Escape -> Escape -> Bool) -> Escape -> Escape -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Escape -> Escape -> Bool
forall c. (Sequential c, Eq (Element c)) => c -> c -> Bool
isInfixOf Escape
currentTestName (Escape -> Bool) -> [Escape] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> [Escape]
testNameMatch Config
cfg)
where currentTestName :: Escape
currentTestName = [Escape] -> Escape
fqTestName (Escape
sEscape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
:[Escape]
acc)
testFilter :: [Escape] -> Test -> Maybe Test
testFilter [Escape]
acc Test
x =
case Test
x of
Group Escape
s [Test]
l ->
let filtered :: [Test]
filtered = [Maybe Test] -> [Test]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Test] -> [Test]) -> [Maybe Test] -> [Test]
forall a b. (a -> b) -> a -> b
$ (Test -> Maybe Test) -> [Test] -> [Maybe Test]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Escape] -> Test -> Maybe Test
testFilter (Escape
sEscape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
:[Escape]
acc)) [Test]
l
in if [Test] -> Bool
forall c. Collection c => c -> Bool
null [Test]
filtered then Maybe Test
forall a. Maybe a
Nothing else Test -> Maybe Test
forall a. a -> Maybe a
Just (Escape -> [Test] -> Test
Group Escape
s [Test]
filtered)
CheckPlan Escape
s Check ()
_
| [Escape] -> Escape -> Bool
match [Escape]
acc Escape
s -> Test -> Maybe Test
forall a. a -> Maybe a
Just Test
x
| Bool
otherwise -> Maybe Test
forall a. Maybe a
Nothing
Unit Escape
s IO ()
_
| [Escape] -> Escape -> Bool
match [Escape]
acc Escape
s -> Test -> Maybe Test
forall a. a -> Maybe a
Just Test
x
| Bool
otherwise -> Maybe Test
forall a. Maybe a
Nothing
Property Escape
s prop
_
| [Escape] -> Escape -> Bool
match [Escape]
acc Escape
s -> Test -> Maybe Test
forall a. a -> Maybe a
Just Test
x
| Bool
otherwise -> Maybe Test
forall a. Maybe a
Nothing
defaultMain :: Test -> IO ()
defaultMain :: Test -> IO ()
defaultMain Test
allTestRoot = do
IO ()
Terminal.initialize
Either Escape Config
ecfg <- ([Escape] -> Config -> Either Escape Config)
-> Config -> [Escape] -> Either Escape Config
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Escape] -> Config -> Either Escape Config
parseArgs Config
defaultConfig ([Escape] -> Either Escape Config)
-> IO [Escape] -> IO (Either Escape Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Escape]
getArgs
Config
cfg <- case Either Escape Config
ecfg of
Left Escape
e -> do
Escape -> IO ()
putStrLn Escape
e
(Escape -> IO ()) -> [Escape] -> IO ()
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ Escape -> IO ()
putStrLn [Escape]
configHelp
IO Config
forall a. IO a
exitFailure
Right Config
c -> Config -> IO Config
forall (f :: * -> *) a. Applicative f => a -> f a
pure Config
c
Word64
seed <- IO Word64 -> (Word64 -> IO Word64) -> Maybe Word64 -> IO Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO Word64
forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64 Word64 -> IO Word64
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Word64 -> IO Word64) -> Maybe Word64 -> IO Word64
forall a b. (a -> b) -> a -> b
$ Config -> Maybe Word64
udfSeed Config
cfg
let testState :: TestState
testState = Config -> Word64 -> TestState
newState Config
cfg Word64
seed
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
helpRequested Config
cfg) ((Escape -> IO ()) -> [Escape] -> IO ()
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ Escape -> IO ()
putStrLn [Escape]
configHelp IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
listTests Config
cfg) (IO ()
printTestName IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess)
Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ Escape
"\nSeed: " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Word64 -> Escape
forall a. Show a => a -> Escape
show Word64
seed Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
"\n"
case Config -> Test -> Maybe Test
filterTestMatching Config
cfg Test
allTestRoot of
Maybe Test
Nothing -> Escape -> IO ()
putStrLn Escape
"no tests to run" IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
forall a. IO a
exitSuccess
Just Test
t -> do
(TestResult
_, TestState
cfg') <- StateT TestState IO TestResult
-> TestState -> IO (TestResult, TestState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (CheckMain TestResult -> StateT TestState IO TestResult
forall a. CheckMain a -> StateT TestState IO a
runCheckMain (CheckMain TestResult -> StateT TestState IO TestResult)
-> CheckMain TestResult -> StateT TestState IO TestResult
forall a b. (a -> b) -> a -> b
$ Test -> CheckMain TestResult
test Test
t) TestState
testState
TestState -> IO ()
forall {b}. TestState -> IO b
summary TestState
cfg'
where
summary :: TestState -> IO b
summary TestState
cfg
| Word
kos Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 = do
Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ Escape
red Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
"Failed " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Word -> Escape
forall a. Show a => a -> Escape
show Word
kos Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
" out of " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Word -> Escape
forall a. Show a => a -> Escape
show Word
tot Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
reset
IO b
forall a. IO a
exitFailure
| Bool
otherwise = do
Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ Escape
green Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
"Succeed " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Word -> Escape
forall a. Show a => a -> Escape
show Word
oks Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
" test(s)" Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
reset
IO b
forall a. IO a
exitSuccess
where
oks :: Word
oks = TestState -> Word
testPassed TestState
cfg
kos :: Word
kos = TestState -> Word
testFailed TestState
cfg
tot :: Word
tot = Word
oks Word -> Word -> Word
forall a. Additive a => a -> a -> a
+ Word
kos
printTestName :: IO ()
printTestName = ([Escape] -> IO ()) -> [[Escape]] -> IO ()
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
(a -> m b) -> col a -> m ()
mapM_ (\[Escape]
tst -> Escape -> IO ()
putStrLn ([Escape] -> Escape
fqTestName [Escape]
tst)) ([[Escape]] -> IO ()) -> [[Escape]] -> IO ()
forall a b. (a -> b) -> a -> b
$ [(Test, [Escape])] -> [Test] -> [Escape] -> Test -> [[Escape]]
testCases [] [] [] Test
allTestRoot
where
testCases :: [(Test, [Escape])] -> [Test] -> [Escape] -> Test -> [[Escape]]
testCases [(Test, [Escape])]
acc [Test]
xs [Escape]
pre Test
x =
case Test
x of
Group Escape
s [Test]
l -> [(Test, [Escape])] -> [Escape] -> [Test] -> [[Escape]]
tToList ((Test -> (Test, [Escape])) -> [Test] -> [(Test, [Escape])]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Test
z -> (Test
z, [Escape]
pre)) [Test]
xs [(Test, [Escape])] -> [(Test, [Escape])] -> [(Test, [Escape])]
forall a. Semigroup a => a -> a -> a
<> [(Test, [Escape])]
acc) (Escape
sEscape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
:[Escape]
pre) [Test]
l
CheckPlan Escape
s Check ()
_ -> (Escape
s Escape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
: [Escape]
pre) [Escape] -> [[Escape]] -> [[Escape]]
forall a. a -> [a] -> [a]
: [(Test, [Escape])] -> [Escape] -> [Test] -> [[Escape]]
tToList [(Test, [Escape])]
acc [Escape]
pre [Test]
xs
Unit Escape
s IO ()
_ -> (Escape
s Escape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
: [Escape]
pre) [Escape] -> [[Escape]] -> [[Escape]]
forall a. a -> [a] -> [a]
: [(Test, [Escape])] -> [Escape] -> [Test] -> [[Escape]]
tToList [(Test, [Escape])]
acc [Escape]
pre [Test]
xs
Property Escape
s prop
_ -> (Escape
s Escape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
: [Escape]
pre) [Escape] -> [[Escape]] -> [[Escape]]
forall a. a -> [a] -> [a]
: [(Test, [Escape])] -> [Escape] -> [Test] -> [[Escape]]
tToList [(Test, [Escape])]
acc [Escape]
pre [Test]
xs
tToList :: [(Test, [Escape])] -> [Escape] -> [Test] -> [[Escape]]
tToList [] [Escape]
_ [] = []
tToList ((Test
a,[Escape]
pre):[(Test, [Escape])]
as) [Escape]
_ [] = [(Test, [Escape])] -> [Test] -> [Escape] -> Test -> [[Escape]]
testCases [(Test, [Escape])]
as [] [Escape]
pre Test
a
tToList [(Test, [Escape])]
acc [Escape]
pre (Test
x:[Test]
xs) = [(Test, [Escape])] -> [Test] -> [Escape] -> Test -> [[Escape]]
testCases [(Test, [Escape])]
acc [Test]
xs [Escape]
pre Test
x
newtype CheckMain a = CheckMain { forall a. CheckMain a -> StateT TestState IO a
runCheckMain :: StateT TestState IO a }
deriving ((forall a b. (a -> b) -> CheckMain a -> CheckMain b)
-> (forall a b. a -> CheckMain b -> CheckMain a)
-> Functor CheckMain
forall a b. a -> CheckMain b -> CheckMain a
forall a b. (a -> b) -> CheckMain a -> CheckMain b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CheckMain b -> CheckMain a
$c<$ :: forall a b. a -> CheckMain b -> CheckMain a
fmap :: forall a b. (a -> b) -> CheckMain a -> CheckMain b
$cfmap :: forall a b. (a -> b) -> CheckMain a -> CheckMain b
Functor, Functor CheckMain
Functor CheckMain
-> (forall a. a -> CheckMain a)
-> (forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b)
-> (forall a b c.
(a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c)
-> (forall a b. CheckMain a -> CheckMain b -> CheckMain b)
-> (forall a b. CheckMain a -> CheckMain b -> CheckMain a)
-> Applicative CheckMain
forall a. a -> CheckMain a
forall a b. CheckMain a -> CheckMain b -> CheckMain a
forall a b. CheckMain a -> CheckMain b -> CheckMain b
forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b
forall a b c.
(a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. CheckMain a -> CheckMain b -> CheckMain a
$c<* :: forall a b. CheckMain a -> CheckMain b -> CheckMain a
*> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
$c*> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
liftA2 :: forall a b c.
(a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c
$cliftA2 :: forall a b c.
(a -> b -> c) -> CheckMain a -> CheckMain b -> CheckMain c
<*> :: forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b
$c<*> :: forall a b. CheckMain (a -> b) -> CheckMain a -> CheckMain b
pure :: forall a. a -> CheckMain a
$cpure :: forall a. a -> CheckMain a
Applicative, Applicative CheckMain
Applicative CheckMain
-> (forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b)
-> (forall a b. CheckMain a -> CheckMain b -> CheckMain b)
-> (forall a. a -> CheckMain a)
-> Monad CheckMain
forall a. a -> CheckMain a
forall a b. CheckMain a -> CheckMain b -> CheckMain b
forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> CheckMain a
$creturn :: forall a. a -> CheckMain a
>> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
$c>> :: forall a b. CheckMain a -> CheckMain b -> CheckMain b
>>= :: forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b
$c>>= :: forall a b. CheckMain a -> (a -> CheckMain b) -> CheckMain b
Monad, Monad CheckMain
Monad CheckMain
-> (forall a. IO a -> CheckMain a) -> MonadIO CheckMain
forall a. IO a -> CheckMain a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> CheckMain a
$cliftIO :: forall a. IO a -> CheckMain a
MonadIO)
instance MonadState CheckMain where
type State CheckMain = TestState
withState :: forall a. (State CheckMain -> (a, State CheckMain)) -> CheckMain a
withState = StateT TestState IO a -> CheckMain a
forall a. StateT TestState IO a -> CheckMain a
CheckMain (StateT TestState IO a -> CheckMain a)
-> ((TestState -> (a, TestState)) -> StateT TestState IO a)
-> (TestState -> (a, TestState))
-> CheckMain a
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (TestState -> (a, TestState)) -> StateT TestState IO a
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState
onDisplayOption :: DisplayOption -> CheckMain () -> CheckMain ()
onDisplayOption :: DisplayOption -> CheckMain () -> CheckMain ()
onDisplayOption DisplayOption
opt CheckMain ()
chk = do
Bool
on <- DisplayOption -> DisplayOption -> Bool
forall a. Ord a => a -> a -> Bool
(<=) DisplayOption
opt (DisplayOption -> Bool)
-> (TestState -> DisplayOption) -> TestState -> Bool
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Config -> DisplayOption
displayOptions (Config -> DisplayOption)
-> (TestState -> Config) -> TestState -> DisplayOption
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TestState -> Config
config (TestState -> Bool) -> CheckMain TestState -> CheckMain Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
if Bool
on then CheckMain ()
chk else () -> CheckMain ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
whenErrorOnly :: CheckMain () -> CheckMain ()
whenErrorOnly :: CheckMain () -> CheckMain ()
whenErrorOnly = DisplayOption -> CheckMain () -> CheckMain ()
onDisplayOption DisplayOption
DisplayTerminalErrorOnly
whenGroupOnly :: CheckMain () -> CheckMain ()
whenGroupOnly :: CheckMain () -> CheckMain ()
whenGroupOnly = DisplayOption -> CheckMain () -> CheckMain ()
onDisplayOption DisplayOption
DisplayGroupOnly
whenVerbose :: CheckMain () -> CheckMain ()
whenVerbose :: CheckMain () -> CheckMain ()
whenVerbose = DisplayOption -> CheckMain () -> CheckMain ()
onDisplayOption DisplayOption
DisplayTerminalVerbose
passed :: CheckMain ()
passed :: CheckMain ()
passed = (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
-> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ \State CheckMain
s -> ((), State CheckMain
TestState
s { testPassed :: Word
testPassed = TestState -> Word
testPassed State CheckMain
TestState
s Word -> Word -> Word
forall a. Additive a => a -> a -> a
+ Word
1 })
failed :: CheckMain ()
failed :: CheckMain ()
failed = (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
-> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ \State CheckMain
s -> ((), State CheckMain
TestState
s { testFailed :: Word
testFailed = TestState -> Word
testFailed State CheckMain
TestState
s Word -> Word -> Word
forall a. Additive a => a -> a -> a
+ Word
1 })
test :: Test -> CheckMain TestResult
test :: Test -> CheckMain TestResult
test (Group Escape
s [Test]
l) = Escape -> [Test] -> CheckMain TestResult
pushGroup Escape
s [Test]
l
test (Unit Escape
_ IO ()
_) = CheckMain TestResult
forall a. HasCallStack => a
undefined
test (CheckPlan Escape
name Check ()
plan) = do
Escape -> Check () -> CheckMain TestResult
testCheckPlan Escape
name Check ()
plan
test (Property Escape
name prop
prop) = do
TestResult
r <- Escape -> Property -> CheckMain TestResult
testProperty Escape
name (prop -> Property
forall p. IsProperty p => p -> Property
property prop
prop)
case TestResult
r of
(PropertyResult Escape
_ CountOf TestResult
nb PropertyResult
PropertySuccess) -> CheckMain () -> CheckMain ()
whenVerbose (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ Escape -> CountOf TestResult -> CheckMain ()
displayPropertySucceed Escape
name CountOf TestResult
nb
(PropertyResult Escape
_ CountOf TestResult
nb (PropertyFailed Escape
w)) -> CheckMain () -> CheckMain ()
whenErrorOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ Escape -> CountOf TestResult -> Escape -> CheckMain ()
displayPropertyFailed Escape
name CountOf TestResult
nb Escape
w
GroupResult {} -> Escape -> CheckMain ()
forall a. HasCallStack => Escape -> a
error Escape
"internal error: should not happen"
TestResult -> CheckMain TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return TestResult
r
displayCurrent :: String -> CheckMain ()
displayCurrent :: Escape -> CheckMain ()
displayCurrent Escape
name = do
CountOf Char
i <- TestState -> CountOf Char
indent (TestState -> CountOf Char)
-> CheckMain TestState -> CheckMain (CountOf Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
IO () -> CheckMain ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CheckMain ()) -> IO () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ CountOf (Element Escape) -> Element Escape -> Escape
forall c. Sequential c => CountOf (Element c) -> Element c -> c
replicate CountOf Char
CountOf (Element Escape)
i Char
Element Escape
' ' Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
name
displayPropertySucceed :: String -> CountOf TestResult -> CheckMain ()
displayPropertySucceed :: Escape -> CountOf TestResult -> CheckMain ()
displayPropertySucceed Escape
name (CountOf Int
nb) = do
CountOf Char
i <- TestState -> CountOf Char
indent (TestState -> CountOf Char)
-> CheckMain TestState -> CheckMain (CountOf Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
IO () -> CheckMain ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CheckMain ()) -> IO () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ [Escape] -> Escape
forall a. Monoid a => [a] -> a
mconcat
[ CountOf (Element Escape) -> Element Escape -> Escape
forall c. Sequential c => CountOf (Element c) -> Element c -> c
replicate CountOf Char
CountOf (Element Escape)
i Char
Element Escape
' '
, Escape
successString, Escape
name
, Escape
" ("
, Int -> Escape
forall a. Show a => a -> Escape
show Int
nb
, if Int
nb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Escape
" test)" else Escape
" tests)"
]
unicodeEnabled :: Bool
unicodeEnabled :: Bool
unicodeEnabled = Bool
True
successString :: String
successString :: Escape
successString
| Bool
unicodeEnabled = Escape
green Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
" ✓ " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
reset
| Bool
otherwise = Escape
green Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
"[SUCCESS] " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
reset
{-# NOINLINE successString #-}
failureString :: String
failureString :: Escape
failureString
| Bool
unicodeEnabled = Escape
red Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
" ✗ " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
reset
| Bool
otherwise = Escape
red Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
"[ ERROR ] " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
reset
{-# NOINLINE failureString #-}
reset, green, red :: ANSI.Escape
reset :: Escape
reset = Escape
ANSI.sgrReset
green :: Escape
green = ColorComponent -> Bool -> Escape
ANSI.sgrForeground (Word64 -> ColorComponent
forall (n :: Nat).
(KnownNat n, NatWithinBound Word64 n) =>
Word64 -> Zn64 n
zn64 Word64
2) Bool
True
red :: Escape
red = ColorComponent -> Bool -> Escape
ANSI.sgrForeground (Word64 -> ColorComponent
forall (n :: Nat).
(KnownNat n, NatWithinBound Word64 n) =>
Word64 -> Zn64 n
zn64 Word64
1) Bool
True
displayPropertyFailed :: String -> CountOf TestResult -> String -> CheckMain ()
displayPropertyFailed :: Escape -> CountOf TestResult -> Escape -> CheckMain ()
displayPropertyFailed Escape
name (CountOf Int
nb) Escape
w = do
Word64
seed <- TestState -> Word64
getSeed (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
CountOf Char
i <- TestState -> CountOf Char
indent (TestState -> CountOf Char)
-> CheckMain TestState -> CheckMain (CountOf Char)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
IO () -> CheckMain ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> CheckMain ()) -> IO () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ do
Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ [Escape] -> Escape
forall a. Monoid a => [a] -> a
mconcat
[ CountOf (Element Escape) -> Element Escape -> Escape
forall c. Sequential c => CountOf (Element c) -> Element c -> c
replicate CountOf Char
CountOf (Element Escape)
i Char
Element Escape
' '
, Escape
failureString, Escape
name
, Escape
" failed after "
, Int -> Escape
forall a. Show a => a -> Escape
show Int
nb
, if Int
nb Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Escape
" test" else Escape
" tests:"
]
Escape -> IO ()
putStrLn (Escape -> IO ()) -> Escape -> IO ()
forall a b. (a -> b) -> a -> b
$ CountOf (Element Escape) -> Element Escape -> Escape
forall c. Sequential c => CountOf (Element c) -> Element c -> c
replicate CountOf Char
CountOf (Element Escape)
i Char
Element Escape
' ' Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
" use param: --seed " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Word64 -> Escape
forall a. Show a => a -> Escape
show Word64
seed
Escape -> IO ()
putStrLn Escape
w
pushGroup :: String -> [Test] -> CheckMain TestResult
pushGroup :: Escape -> [Test] -> CheckMain TestResult
pushGroup Escape
name [Test]
list = do
CheckMain () -> CheckMain ()
whenGroupOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ if [Test] -> Bool
groupHasSubGroup [Test]
list then Escape -> CheckMain ()
displayCurrent Escape
name else () -> CheckMain ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
-> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ \State CheckMain
s -> ((), State CheckMain
TestState
s { testPath :: DList Escape
testPath = DList Escape -> Element (DList Escape) -> DList Escape
push (TestState -> DList Escape
testPath State CheckMain
TestState
s) Escape
Element (DList Escape)
name, indent :: CountOf Char
indent = TestState -> CountOf Char
indent State CheckMain
TestState
s CountOf Char -> CountOf Char -> CountOf Char
forall a. Additive a => a -> a -> a
+ CountOf Char
2 })
[TestResult]
results <- (Test -> CheckMain TestResult) -> [Test] -> CheckMain [TestResult]
forall (collection :: * -> *) (m :: * -> *) a b.
(Mappable collection, Applicative m, Monad m) =>
(a -> m b) -> collection a -> m (collection b)
mapM Test -> CheckMain TestResult
test [Test]
list
(State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall (m :: * -> *) a.
MonadState m =>
(State m -> (a, State m)) -> m a
withState ((State CheckMain -> ((), State CheckMain)) -> CheckMain ())
-> (State CheckMain -> ((), State CheckMain)) -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ \State CheckMain
s -> ((), State CheckMain
TestState
s { testPath :: DList Escape
testPath = DList Escape -> DList Escape
pop (TestState -> DList Escape
testPath State CheckMain
TestState
s), indent :: CountOf Char
indent = TestState -> CountOf Char
indent State CheckMain
TestState
s CountOf Char -> CountOf Char -> CountOf Char
forall a. CountOf a -> CountOf a -> CountOf a
`sizeSub` CountOf Char
2 })
let totFail :: Element [CountOf TestResult]
totFail = [CountOf TestResult] -> Element [CountOf TestResult]
sum ([CountOf TestResult] -> Element [CountOf TestResult])
-> [CountOf TestResult] -> Element [CountOf TestResult]
forall a b. (a -> b) -> a -> b
$ (TestResult -> CountOf TestResult)
-> [TestResult] -> [CountOf TestResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestResult -> CountOf TestResult
nbFail [TestResult]
results
tot :: Element [CountOf TestResult]
tot = [CountOf TestResult] -> Element [CountOf TestResult]
sum ([CountOf TestResult] -> Element [CountOf TestResult])
-> [CountOf TestResult] -> Element [CountOf TestResult]
forall a b. (a -> b) -> a -> b
$ (TestResult -> CountOf TestResult)
-> [TestResult] -> [CountOf TestResult]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TestResult -> CountOf TestResult
nbTests [TestResult]
results
CheckMain () -> CheckMain ()
whenGroupOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ case ([Test] -> Bool
groupHasSubGroup [Test]
list, CountOf TestResult
Element [CountOf TestResult]
totFail) of
(Bool
True, CountOf TestResult
_) -> () -> CheckMain ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(Bool
False, CountOf TestResult
n) | CountOf TestResult
n CountOf TestResult -> CountOf TestResult -> Bool
forall a. Ord a => a -> a -> Bool
> CountOf TestResult
0 -> Escape -> CountOf TestResult -> Escape -> CheckMain ()
displayPropertyFailed Escape
name CountOf TestResult
n Escape
""
| Bool
otherwise -> Escape -> CountOf TestResult -> CheckMain ()
displayPropertySucceed Escape
name CountOf TestResult
Element [CountOf TestResult]
tot
TestResult -> CheckMain TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return (TestResult -> CheckMain TestResult)
-> TestResult -> CheckMain TestResult
forall a b. (a -> b) -> a -> b
$ Escape
-> CountOf TestResult
-> CountOf TestResult
-> [TestResult]
-> TestResult
GroupResult Escape
name CountOf TestResult
Element [CountOf TestResult]
totFail CountOf TestResult
Element [CountOf TestResult]
tot [TestResult]
results
where
sum :: [CountOf TestResult] -> Element [CountOf TestResult]
sum = (Element [CountOf TestResult]
-> Element [CountOf TestResult] -> Element [CountOf TestResult])
-> Element [CountOf TestResult]
-> [CountOf TestResult]
-> Element [CountOf TestResult]
forall collection a.
Foldable collection =>
(a -> Element collection -> a) -> a -> collection -> a
foldl' Element [CountOf TestResult]
-> Element [CountOf TestResult] -> Element [CountOf TestResult]
forall a. Additive a => a -> a -> a
(+) Element [CountOf TestResult]
0
push :: DList Escape -> Element (DList Escape) -> DList Escape
push = DList Escape -> Element (DList Escape) -> DList Escape
forall c. Sequential c => c -> Element c -> c
snoc
pop :: DList Escape -> DList Escape
pop = DList Escape
-> ((DList Escape, Element (DList Escape)) -> DList Escape)
-> Maybe (DList Escape, Element (DList Escape))
-> DList Escape
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DList Escape
forall a. Monoid a => a
mempty (DList Escape, Element (DList Escape)) -> DList Escape
forall a b. (a, b) -> a
fst (Maybe (DList Escape, Element (DList Escape)) -> DList Escape)
-> (DList Escape -> Maybe (DList Escape, Element (DList Escape)))
-> DList Escape
-> DList Escape
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. DList Escape -> Maybe (DList Escape, Element (DList Escape))
forall c. Sequential c => c -> Maybe (c, Element c)
unsnoc
testCheckPlan :: String -> Check () -> CheckMain TestResult
testCheckPlan :: Escape -> Check () -> CheckMain TestResult
testCheckPlan Escape
name Check ()
actions = do
Word64
seed <- TestState -> Word64
getSeed (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
DList Escape
path <- TestState -> DList Escape
testPath (TestState -> DList Escape)
-> CheckMain TestState -> CheckMain (DList Escape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
GenParams
params <- Config -> GenParams
getGenParams (Config -> GenParams)
-> (TestState -> Config) -> TestState -> GenParams
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TestState -> Config
config (TestState -> GenParams)
-> CheckMain TestState -> CheckMain GenParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
let rngIt :: Word64 -> GenRng
rngIt = Word64 -> [Escape] -> Word64 -> GenRng
genRng Word64
seed (Escape
name Escape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
: DList Escape -> [Item (DList Escape)]
forall l. IsList l => l -> [Item l]
toList DList Escape
path)
let planState :: PlanState
planState = PlanState :: (Word64 -> GenRng)
-> CountOf TestResult -> GenParams -> [TestResult] -> PlanState
PlanState { planRng :: Word64 -> GenRng
planRng = Word64 -> GenRng
rngIt
, planValidations :: CountOf TestResult
planValidations = CountOf TestResult
0
, planParams :: GenParams
planParams = GenParams
params
, planFailures :: [TestResult]
planFailures = []
}
PlanState
st <- IO PlanState -> CheckMain PlanState
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (((), PlanState) -> PlanState
forall a b. (a, b) -> b
snd (((), PlanState) -> PlanState)
-> IO ((), PlanState) -> IO PlanState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StateT PlanState IO () -> PlanState -> IO ((), PlanState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (Check () -> StateT PlanState IO ()
forall a. Check a -> StateT PlanState IO a
runCheck Check ()
actions) PlanState
planState)
let fails :: [TestResult]
fails = PlanState -> [TestResult]
planFailures PlanState
st
if [TestResult] -> Bool
forall c. Collection c => c -> Bool
null [TestResult]
fails
then TestResult -> CheckMain TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Escape
-> CountOf TestResult
-> CountOf TestResult
-> [TestResult]
-> TestResult
GroupResult Escape
name CountOf TestResult
0 (PlanState -> CountOf TestResult
planValidations PlanState
st) [])
else do
Escape -> CheckMain ()
displayCurrent Escape
name
[TestResult] -> (TestResult -> CheckMain ()) -> CheckMain ()
forall (col :: * -> *) (m :: * -> *) a b.
(Mappable col, Applicative m, Monad m) =>
col a -> (a -> m b) -> m ()
forM_ [TestResult]
fails ((TestResult -> CheckMain ()) -> CheckMain ())
-> (TestResult -> CheckMain ()) -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ \(PropertyResult Escape
name' CountOf TestResult
nb PropertyResult
r) ->
case PropertyResult
r of
PropertyResult
PropertySuccess -> CheckMain () -> CheckMain ()
whenVerbose (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ Escape -> CountOf TestResult -> CheckMain ()
displayPropertySucceed (Escape
name Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
": " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
name') CountOf TestResult
nb
PropertyFailed Escape
w -> CheckMain () -> CheckMain ()
whenErrorOnly (CheckMain () -> CheckMain ()) -> CheckMain () -> CheckMain ()
forall a b. (a -> b) -> a -> b
$ Escape -> CountOf TestResult -> Escape -> CheckMain ()
displayPropertyFailed (Escape
name Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
": " Escape -> Escape -> Escape
forall a. Semigroup a => a -> a -> a
<> Escape
name') CountOf TestResult
nb Escape
w
TestResult -> CheckMain TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Escape
-> CountOf TestResult
-> CountOf TestResult
-> [TestResult]
-> TestResult
GroupResult Escape
name ([TestResult] -> CountOf (Element [TestResult])
forall c. Collection c => c -> CountOf (Element c)
length [TestResult]
fails) (PlanState -> CountOf TestResult
planValidations PlanState
st) [TestResult]
fails)
testProperty :: String -> Property -> CheckMain TestResult
testProperty :: Escape -> Property -> CheckMain TestResult
testProperty Escape
name Property
prop = do
Word64
seed <- TestState -> Word64
getSeed (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
DList Escape
path <- TestState -> DList Escape
testPath (TestState -> DList Escape)
-> CheckMain TestState -> CheckMain (DList Escape)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
let rngIt :: Word64 -> GenRng
rngIt = Word64 -> [Escape] -> Word64 -> GenRng
genRng Word64
seed (Escape
name Escape -> [Escape] -> [Escape]
forall a. a -> [a] -> [a]
: DList Escape -> [Item (DList Escape)]
forall l. IsList l => l -> [Item l]
toList DList Escape
path)
GenParams
params <- Config -> GenParams
getGenParams (Config -> GenParams)
-> (TestState -> Config) -> TestState -> GenParams
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TestState -> Config
config (TestState -> GenParams)
-> CheckMain TestState -> CheckMain GenParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
Word64
maxTests <- Config -> Word64
numTests (Config -> Word64) -> (TestState -> Config) -> TestState -> Word64
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TestState -> Config
config (TestState -> Word64) -> CheckMain TestState -> CheckMain Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CheckMain TestState
forall (m :: * -> *). MonadState m => m (State m)
get
(PropertyResult
res,CountOf TestResult
nb) <- IO (PropertyResult, CountOf TestResult)
-> CheckMain (PropertyResult, CountOf TestResult)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (PropertyResult, CountOf TestResult)
-> CheckMain (PropertyResult, CountOf TestResult))
-> IO (PropertyResult, CountOf TestResult)
-> CheckMain (PropertyResult, CountOf TestResult)
forall a b. (a -> b) -> a -> b
$ CountOf TestResult
-> GenParams
-> (Word64 -> GenRng)
-> Property
-> IO (PropertyResult, CountOf TestResult)
iterateProperty (Int -> CountOf TestResult
forall ty. Int -> CountOf ty
CountOf (Int -> CountOf TestResult) -> Int -> CountOf TestResult
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. IntegralDownsize a b => a -> b
integralDownsize (Word64 -> Int64
forall source destination.
Cast source destination =>
source -> destination
cast Word64
maxTests :: Int64)) GenParams
params Word64 -> GenRng
rngIt Property
prop
case PropertyResult
res of
PropertyFailed {} -> CheckMain ()
failed
PropertyResult
PropertySuccess -> CheckMain ()
passed
TestResult -> CheckMain TestResult
forall (m :: * -> *) a. Monad m => a -> m a
return (Escape -> CountOf TestResult -> PropertyResult -> TestResult
PropertyResult Escape
name CountOf TestResult
nb PropertyResult
res)