diff options
Diffstat (limited to 'test')
-rw-r--r-- | test/Property.hs | 57 |
1 files changed, 54 insertions, 3 deletions
diff --git a/test/Property.hs b/test/Property.hs index 44d6f56..8b9f338 100644 --- a/test/Property.hs +++ b/test/Property.hs @@ -1,3 +1,8 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeApplications #-} + module Property ( propertyTests ) @@ -5,13 +10,19 @@ where import Data.Either (either, isRight) import qualified Data.Graph.Inductive as G -import Hedgehog (Gen, Property, (===)) +import Data.Text (Text) +import qualified Data.Text as T +import Hedgehog (Gen, MonadGen, Property, (===)) import qualified Hedgehog as Hog +import Hedgehog.Function (Arg, Vary) +import qualified Hedgehog.Function as Hog import qualified Hedgehog.Gen as Hog +import qualified Hedgehog.Range as Hog import Test.Tasty import Test.Tasty.Hedgehog import Text.Parsec import VeriFuzz +import VeriFuzz.Result import VeriFuzz.Verilog.Lex import VeriFuzz.Verilog.Parser @@ -47,10 +58,50 @@ parserIdempotent = Hog.property $ do . parse parseModDecl "idempotent_test.v" $ alexScanTokens sv +type GenFunctor f a b c = + ( Functor f + , Show (f a) + , Show a, Arg a, Vary a + , Show b, Arg b, Vary b + , Show c + , Eq (f c) + , Show (f c) + ) + +mapCompose + :: forall f a b c + . GenFunctor f a b c + => (forall x. Gen x -> Gen (f x)) + -> Gen a + -> Gen b + -> Gen c + -> Property +mapCompose genF genA genB genC = + Hog.property $ do + g <- Hog.forAllFn $ Hog.fn @a genB + f <- Hog.forAllFn $ Hog.fn @b genC + xs <- Hog.forAll $ genF genA + fmap (f . g) xs === fmap f (fmap g xs) + +propertyResultInterrupted :: Property +propertyResultInterrupted = do + mapCompose + genResult + (Hog.int (Hog.linear 0 100)) + (Hog.int (Hog.linear 0 100)) + (Hog.int (Hog.linear 0 100)) + where + genResult :: Gen a -> Gen (Result Text a) + genResult a = Hog.choice + [ Pass <$> a + , Fail <$> Hog.text (Hog.linear 1 100) Hog.unicode + ] + propertyTests :: TestTree propertyTests = testGroup "Property Tests" [ testProperty "simple graph generation check" simpleGraph - , testProperty "parser input" parserInput - , testProperty "parser idempotence" parserIdempotent +-- , testProperty "parser input" parserInput +-- , testProperty "parser idempotence" parserIdempotent + , testProperty "fmap for Result" propertyResultInterrupted ] |