diff --git a/clash-protocols/src/Protocols/Hedgehog/Internal.hs b/clash-protocols/src/Protocols/Hedgehog/Internal.hs index 37ef740..19846d5 100644 --- a/clash-protocols/src/Protocols/Hedgehog/Internal.hs +++ b/clash-protocols/src/Protocols/Hedgehog/Internal.hs @@ -19,6 +19,8 @@ import Prelude -- clash-protocols import Protocols import qualified Protocols.Df as Df +import Protocols.Hedgehog.Types +import Protocols.Internal.TH -- clash-prelude import Clash.Prelude (type (*), type (+), type (<=)) @@ -28,9 +30,6 @@ import qualified Clash.Prelude as C import qualified Hedgehog as H import qualified Hedgehog.Internal.Property as H --- me -import Protocols.Hedgehog.Types - {- | Resets for 30 cycles, checks for superfluous data for 50 cycles after seeing last valid data cycle, and times out after seeing 1000 consecutive empty cycles. @@ -124,3 +123,8 @@ instance trimmedA <- expectN (Proxy @a) opts sampledA trimmedB <- expectN (Proxy @b) opts sampledB pure (trimmedA, trimmedB) + +-- XXX: We only generate up to 9 tuples instead of maxTupleSize because NFData +-- instances are only available up to 9-tuples. +-- see https://hackage.haskell.org/package/deepseq-1.5.1.0/docs/src/Control.DeepSeq.html#line-1125 +testTupleInstances 3 9 diff --git a/clash-protocols/src/Protocols/Internal/TH.hs b/clash-protocols/src/Protocols/Internal/TH.hs index c3c9ffd..4e682f0 100644 --- a/clash-protocols/src/Protocols/Internal/TH.hs +++ b/clash-protocols/src/Protocols/Internal/TH.hs @@ -7,6 +7,7 @@ import Control.Monad.Extra (concatMapM) import Data.Proxy import GHC.TypeNats import Language.Haskell.TH +import Protocols.Hedgehog.Types import Protocols.Internal.Types import Protocols.Plugin @@ -175,3 +176,27 @@ backPressureTupleInstance n = circTys = map (\i -> varT $ mkName $ "c" <> show i) [1 .. n] instCtx = foldl appT (tupleT n) $ map (\ty -> [t|Backpressure $ty|]) circTys instTy = foldl appT (tupleT n) circTys + +testTupleInstances :: Int -> Int -> DecsQ +testTupleInstances n m = concatMapM testTupleInstance [n .. m] + +testTupleInstance :: Int -> DecsQ +testTupleInstance n = + [d| + instance ($instCtx) => Test $instTy where + expectN Proxy $(varP $ mkName "opts") $(tupP sampledPats) = $(doE stmts) + |] + where + circStrings = map (\i -> "c" <> show i) [1 .. n] + circTys = map (varT . mkName) circStrings + instCtx = foldl appT (tupleT n) $ map (\ty -> [t|Test $ty|]) circTys + instTy = foldl appT (tupleT n) circTys + + sampledPats = map (varP . mkName . ("sampled" <>)) circStrings + sampledExprs = map (varE . mkName . ("sampled" <>)) circStrings + trimmedPats = map (varP . mkName . ("trimmed" <>)) circStrings + trimmedExprs = map (varE . mkName . ("trimmed" <>)) circStrings + + mkTrimStmt trim ty sam = bindS trim [e|expectN (Proxy @($ty)) opts $sam|] + expectResult = noBindS [e|pure $(tupE trimmedExprs)|] + stmts = zipWith3 mkTrimStmt trimmedPats circTys sampledExprs <> [expectResult]