Start9/registry
2
0
Fork 0
mirror of https://github.com/Start9Labs/registry.git synced 2026-04-01 20:44:15 +00:00
Code Issues Packages Projects Releases Wiki Activity

wip

Browse Source
This commit is contained in:
Keagan McClelland
2022-06-16 12:06:02 -06:00
parent cda52c8f3d
commit eb8122be18
2 changed files with 68 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
test/Lib/Types/EmverProp.hs
View File

@@ -213,13 +213,23 @@ prop_reduceTerminates = withTests 1000 . property $ do
prop_reduceIdentity :: Property
prop_reduceIdentity = withTests 1000 . property $ do
a <- forAll $ filter ((<= 100) . nodes) rangeGen
a <- forAll $ filter (((>= 3) <&&> (<= 100)) . nodes) rangeGen
obs <- forAll versionGen
b <- liftIO $ pure (reduce a) `catch` \e -> throwIO (e :: ErrorCall)
let b = reduce a
unless (b /= a) Test.discard
obs <|| a === obs <|| b
prop_reduceIdempotence :: Property
prop_reduceIdempotence = withTests 1000 . property $ do
a <- forAll $ filter (((>= 3) <&&> (<= 100)) . nodes) rangeGen
let b = reduce a
annotateShow b
let c = reduce b
annotateShow c
b === c
prop_reduceConjTreeNormalForm :: Property
prop_reduceConjTreeNormalForm = withTests 1000 . property $ do
a <- forAll $ filter ((<= 100) . nodes) conjOnlyGen
@@ -252,7 +262,7 @@ isConjNF = \case
opc == neq && opd == neq && opa /= neq && opb /= neq && pta < ptb && ptc < ptd && ptc > pta && ptd < ptb
(Conj x@(Conj (Anchor opa pta) (Anchor opb ptb)) (Conj (Anchor opc ptc) r)) ->
pta < ptc && ptc < ptb && opa /= neq && opb /= neq && opc == neq && isConjNF (Conj x r)
(Conj a@(Anchor opa pta) y'@(Conj (Anchor opb ptb) r)) ->
(Conj a@(Anchor opa pta) y'@(Conj (Anchor _ ptb) r)) ->
(opa == neq && pta < ptb && isConjNF y')
|| (fr opa && pta < ptb && isConjNF y')
|| (fl opa && pta > ptb && isConjNF (Conj a r))