From a38eadc74b33cc1e15cf5f56c1b4c7c92c2e61a4 Mon Sep 17 00:00:00 2001 From: t-wallet Date: Fri, 30 Aug 2024 18:21:33 +0200 Subject: [PATCH] Allow user to pass custom packet generator to genPackets --- .../src/Protocols/PacketStream/Hedgehog.hs | 75 ++++++++++--------- .../Tests/Protocols/PacketStream/AsyncFifo.hs | 4 +- .../Protocols/PacketStream/Converters.hs | 6 +- .../Tests/Protocols/PacketStream/Delay.hs | 7 +- .../Protocols/PacketStream/Depacketizers.hs | 4 +- .../Protocols/PacketStream/PacketFifo.hs | 26 ++++--- .../Protocols/PacketStream/Packetizers.hs | 6 +- .../Tests/Protocols/PacketStream/Routing.hs | 7 +- 8 files changed, 79 insertions(+), 56 deletions(-) diff --git a/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs b/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs index 0345a45f..63196337 100644 --- a/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs +++ b/clash-protocols/src/Protocols/PacketStream/Hedgehog.hs @@ -29,7 +29,7 @@ module Protocols.PacketStream.Hedgehog ( -- * Hedgehog generators AbortMode (..), genValidPacket, - genValidPackets, + genPackets, ) where import Prelude @@ -159,7 +159,7 @@ downConvert :: downConvert = concatMap chopPacket {- | -Merges a list of `PacketStream` transfers with data width @dataWidth into +Merges a list of `PacketStream` transfers with data width @dataWidth@ into a list of `PacketStream` transfers with data width @1@ -} upConvert :: @@ -309,75 +309,78 @@ Otherwise, transfers of roughly 50% of the packets will randomly have _abort set data AbortMode = Abort | NoAbort {- | -Generate valid packets, i.e. packets of which all transfers carry the same -`_meta` and with all unenabled bytes in `_data` set to 0x00. +Generate packets with a user-supplied generator. -} -genValidPackets :: - forall (dataWidth :: C.Nat) (metaType :: C.Type). +genPackets :: + forall (dataWidth :: C.Nat) (meta :: C.Type). (1 C.<= dataWidth) => (C.KnownNat dataWidth) => - (C.BitPack metaType) => -- | The amount of packets to generate. Range Int -> - -- | The amount of transfers with @_last = Nothing@ to generate per packet. - -- This function will always generate an extra transfer per packet - -- with @_last = Just i@. - Range Int -> - -- | If set to @NoAbort@, no generated packets will have `_abort` set in - -- any of their transfers. Else, roughly 50% of packets will contain - -- fragments with their `_abort` randomly set. + -- | If set to @NoAbort@, always pass @NoAbort@ to the packet generator. + -- Else, pass @Abort@ to roughly 50% of the packet generators. AbortMode -> - Gen [PacketStreamM2S dataWidth metaType] -genValidPackets pkts size Abort = concat <$> Gen.list pkts gen - where - gen = do - abortPacket <- Gen.bool - genValidPacket size (if abortPacket then Abort else NoAbort) -genValidPackets pkts size NoAbort = - concat <$> Gen.list pkts (genValidPacket size NoAbort) + -- | Packet generator. + (AbortMode -> Gen [PacketStreamM2S dataWidth meta]) -> + Gen [PacketStreamM2S dataWidth meta] +genPackets pkts Abort pktGen = + concat + <$> Gen.list + pkts + (Gen.choice [pktGen Abort, pktGen NoAbort]) +genPackets pkts NoAbort pktGen = + concat + <$> Gen.list + pkts + (pktGen NoAbort) {- | Generate a valid packet, i.e. a packet of which all transfers carry the same `_meta` and with all unenabled bytes in `_data` set to 0x00. -} genValidPacket :: - forall (dataWidth :: C.Nat) (metaType :: C.Type). + forall (dataWidth :: C.Nat) (meta :: C.Type). (1 C.<= dataWidth) => (C.KnownNat dataWidth) => - (C.BitPack metaType) => + -- | Generator for the metadata. + Gen meta -> -- | The amount of transfers with @_last = Nothing@ to generate. -- This function will always generate an extra transfer with @_last = Just i@. Range Int -> -- | If set to @NoAbort@, no transfers in the packet will have @_abort@ set. - -- Else, they will randomly have @_abort@ set. + -- Else, each transfer has a 10% chance to have @_abort@ set. AbortMode -> - Gen [PacketStreamM2S dataWidth metaType] -genValidPacket size abortMode = do - meta <- C.unpack <$> Gen.enumBounded + Gen [PacketStreamM2S dataWidth meta] +genValidPacket metaGen size abortMode = do + meta <- metaGen transfers <- Gen.list size (genTransfer @dataWidth meta abortMode) lastTransfer <- genLastTransfer @dataWidth meta abortMode pure (transfers ++ [lastTransfer]) -- | Generate a single transfer which is not yet the end of a packet. genTransfer :: - forall (dataWidth :: C.Nat) (metaType :: C.Type). + forall (dataWidth :: C.Nat) (meta :: C.Type). (1 C.<= dataWidth) => (C.KnownNat dataWidth) => -- | We need to use the same metadata -- for every transfer in a packet to satisfy the protocol -- invariant that metadata is constant for an entire packet. - metaType -> + meta -> -- | If set to @NoAbort@, hardcode @_abort@ to @False@. Else, - -- randomly generate it. + -- there is a 10% chance for it to be set. AbortMode -> - Gen (PacketStreamM2S dataWidth metaType) + Gen (PacketStreamM2S dataWidth meta) genTransfer meta abortMode = PacketStreamM2S <$> genVec Gen.enumBounded <*> Gen.constant Nothing <*> Gen.constant meta <*> case abortMode of - Abort -> Gen.enumBounded + Abort -> + Gen.frequency + [ (90, Gen.constant False) + , (10, Gen.constant True) + ] NoAbort -> Gen.constant False {- | @@ -385,17 +388,17 @@ Generate the last transfer of a packet, i.e. a transfer with @_last@ set as @Jus All bytes which are not enabled are set to 0x00. -} genLastTransfer :: - forall (dataWidth :: C.Nat) (metaType :: C.Type). + forall (dataWidth :: C.Nat) (meta :: C.Type). (1 C.<= dataWidth) => (C.KnownNat dataWidth) => -- | We need to use the same metadata -- for every transfer in a packet to satisfy the protocol -- invariant that metadata is constant for an entire packet. - metaType -> + meta -> -- | If set to @NoAbort@, hardcode @_abort@ to @False@. Else, -- randomly generate it. AbortMode -> - Gen (PacketStreamM2S dataWidth metaType) + Gen (PacketStreamM2S dataWidth meta) genLastTransfer meta abortMode = setNull <$> ( PacketStreamM2S diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/AsyncFifo.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/AsyncFifo.hs index 8ece86c5..393152d8 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/AsyncFifo.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/AsyncFifo.hs @@ -6,6 +6,7 @@ module Tests.Protocols.PacketStream.AsyncFifo where import Clash.Prelude import Hedgehog (Property) +import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty (TestTree, localOption, mkTimeout) @@ -70,7 +71,8 @@ generateAsyncFifoIdProp :: generateAsyncFifoIdProp wClk wRst wEn rClk rRst rEn = idWithModel defExpectOptions - (genValidPackets (Range.linear 1 10) (Range.linear 1 30) Abort) + ( genPackets (Range.linear 1 10) Abort (genValidPacket Gen.enumBounded (Range.linear 1 30)) + ) id (asyncFifoC @wDom @rDom @4 @1 @Int d4 wClk wRst wEn rClk rRst rEn) diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Converters.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Converters.hs index 3cebebde..ac48662f 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Converters.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Converters.hs @@ -5,6 +5,7 @@ module Tests.Protocols.PacketStream.Converters where import Clash.Prelude import Hedgehog (Property) +import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty @@ -29,7 +30,8 @@ generateUpConverterProperty :: generateUpConverterProperty SNat SNat = idWithModelSingleDomain defExpectOptions - (genValidPackets (Range.linear 1 10) (Range.linear 1 20) Abort) + ( genPackets (Range.linear 1 10) Abort (genValidPacket Gen.enumBounded (Range.linear 1 20)) + ) (exposeClockResetEnable (upConvert . downConvert)) (exposeClockResetEnable @System (upConverterC @dwIn @dwOut @Int)) @@ -64,7 +66,7 @@ generateDownConverterProperty :: generateDownConverterProperty SNat SNat = idWithModelSingleDomain defExpectOptions{eoSampleMax = 1000} - (genValidPackets (Range.linear 1 8) (Range.linear 1 10) Abort) + (genPackets (Range.linear 1 8) Abort (genValidPacket Gen.enumBounded (Range.linear 1 10))) (exposeClockResetEnable (upConvert . downConvert)) (exposeClockResetEnable @System (downConverterC @dwIn @dwOut @Int)) diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Delay.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Delay.hs index 65d19a5e..1660b78c 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Delay.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Delay.hs @@ -8,6 +8,7 @@ module Tests.Protocols.PacketStream.Delay ( import Clash.Prelude import Hedgehog +import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty @@ -25,14 +26,14 @@ prop_delaystream_id = idWithModelSingleDomain @System defExpectOptions - (genValidPackets (Range.linear 1 10) (Range.linear 1 6) Abort) + (genPackets (Range.linear 1 10) Abort (genValidPacket Gen.enumBounded (Range.linear 1 6))) (exposeClockResetEnable id) (exposeClockResetEnable ckt) where ckt :: (HiddenClockResetEnable System) => - Circuit (PacketStream System 2 ()) (PacketStream System 2 ()) - ckt = delayStream @System @2 @() @4 d4 + Circuit (PacketStream System 2 Int) (PacketStream System 2 Int) + ckt = delayStream @System @2 @Int @4 d4 tests :: TestTree tests = diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Depacketizers.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Depacketizers.hs index 7988cc0e..d62ba34d 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Depacketizers.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Depacketizers.hs @@ -38,7 +38,7 @@ depacketizerPropertyGenerator SNat SNat = idWithModelSingleDomain @System defExpectOptions{eoSampleMax = 1000, eoStopAfterEmpty = 1000} - (genValidPackets (Range.linear 1 4) (Range.linear 1 30) Abort) + (genPackets (Range.linear 1 4) Abort (genValidPacket (pure ()) (Range.linear 1 30))) (exposeClockResetEnable model) (exposeClockResetEnable ckt) where @@ -82,7 +82,7 @@ depacketizeToDfPropertyGenerator SNat SNat = idWithModelSingleDomain @System defExpectOptions{eoSampleMax = 1000, eoStopAfterEmpty = 1000} - (genValidPackets (Range.linear 1 4) (Range.linear 1 30) NoAbort) + (genPackets (Range.linear 1 10) Abort (genValidPacket (pure ()) (Range.linear 1 20))) (exposeClockResetEnable model) (exposeClockResetEnable ckt) where diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/PacketFifo.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/PacketFifo.hs index 175693e7..9095da0e 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/PacketFifo.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/PacketFifo.hs @@ -10,7 +10,8 @@ import Clash.Prelude import Data.Int (Int16) import qualified Data.List as L -import Hedgehog as H +import Hedgehog +import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty @@ -30,7 +31,8 @@ prop_packetFifo_id = idWithModelSingleDomain @System defExpectOptions{eoSampleMax = 1000, eoStopAfterEmpty = 1000} - (genValidPackets (Range.linear 1 30) (Range.linear 1 10) Abort) + ( genPackets (Range.linear 1 30) Abort (genValidPacket Gen.enumBounded (Range.linear 1 10)) + ) (exposeClockResetEnable dropAbortedPackets) (exposeClockResetEnable ckt) where @@ -45,7 +47,8 @@ prop_packetFifo_small_buffer_id = idWithModelSingleDomain @System defExpectOptions{eoSampleMax = 1000, eoStopAfterEmpty = 1000} - (genValidPackets (Range.linear 1 10) (Range.linear 1 30) NoAbort) + ( genPackets (Range.linear 1 10) Abort (genValidPacket Gen.enumBounded (Range.linear 1 30)) + ) (exposeClockResetEnable dropAbortedPackets) (exposeClockResetEnable ckt) where @@ -65,9 +68,13 @@ prop_packetFifo_no_gaps = property $ do systemClockGen resetGen enableGen - gen = genValidPackets (Range.linear 1 10) (Range.linear 1 10) NoAbort + gen = + genPackets + (Range.linear 1 10) + NoAbort + (genValidPacket Gen.enumBounded (Range.linear 1 10)) - packets :: [PacketStreamM2S 4 Int16] <- H.forAll gen + packets :: [PacketStreamM2S 4 Int16] <- forAll gen let packetSize = 2 Prelude.^ snatToInteger packetFifoSize cfg = SimulationConfig 1 (2 * packetSize) False @@ -86,7 +93,8 @@ prop_overFlowDrop_packetFifo_id = idWithModelSingleDomain @System defExpectOptions{eoSampleMax = 2000, eoStopAfterEmpty = 1000} - (genValidPackets (Range.linear 1 30) (Range.linear 1 10) Abort) + ( genPackets (Range.linear 1 30) Abort (genValidPacket Gen.enumBounded (Range.linear 1 10)) + ) (exposeClockResetEnable dropAbortedPackets) (exposeClockResetEnable ckt) where @@ -116,8 +124,8 @@ prop_overFlowDrop_packetFifo_drop = where packetChunk = chunkByPacket packets - genSmall = genValidPacket (Range.linear 1 5) NoAbort - genBig = genValidPacket (Range.linear 33 33) NoAbort + genSmall = genValidPacket Gen.enumBounded (Range.linear 1 5) NoAbort + genBig = genValidPacket Gen.enumBounded (Range.linear 33 33) NoAbort -- | test for id using a small metabuffer to ensure backpressure using the metabuffer is tested prop_packetFifo_small_metaBuffer :: Property @@ -125,7 +133,7 @@ prop_packetFifo_small_metaBuffer = idWithModelSingleDomain @System defExpectOptions - (genValidPackets (Range.linear 1 30) (Range.linear 1 4) Abort) + (genPackets (Range.linear 1 30) Abort (genValidPacket Gen.enumBounded (Range.linear 1 4))) (exposeClockResetEnable dropAbortedPackets) (exposeClockResetEnable ckt) where diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Packetizers.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Packetizers.hs index 36617f6b..b7d1d742 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Packetizers.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Packetizers.hs @@ -40,7 +40,11 @@ packetizerPropertyGenerator SNat SNat = idWithModelSingleDomain @System defExpectOptions - (genValidPackets (Range.linear 1 10) (Range.linear 1 10) Abort) + ( genPackets + (Range.linear 1 10) + Abort + (genValidPacket (genVec Gen.enumBounded) (Range.linear 1 10)) + ) (exposeClockResetEnable model) (exposeClockResetEnable ckt) where diff --git a/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs b/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs index 96e9f110..e008e8a0 100644 --- a/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs +++ b/clash-protocols/tests/Tests/Protocols/PacketStream/Routing.hs @@ -8,6 +8,7 @@ import Clash.Prelude import qualified Clash.Prelude as C import Hedgehog hiding (Parallel) +import qualified Hedgehog.Gen as Gen import qualified Hedgehog.Range as Range import Test.Tasty @@ -64,7 +65,8 @@ makePropPacketArbiter _ _ mode = where genSources = mapM setMeta (indicesI @p) setMeta j = do - pkts <- genValidPackets @n @() (Range.linear 1 10) (Range.linear 1 10) Abort + pkts <- + genPackets @n (Range.linear 1 10) Abort (genValidPacket (pure ()) (Range.linear 1 10)) pure $ L.map (\pkt -> pkt{_meta = j}) pkts partitionPackets packets = @@ -106,6 +108,7 @@ makePropPacketDispatcher :: , 1 <= dataWidth , TestType a , Bounded a + , Enum a , BitPack a ) => SNat dataWidth -> @@ -114,7 +117,7 @@ makePropPacketDispatcher :: makePropPacketDispatcher _ fs = idWithModelSingleDomain @System defExpectOptions{eoSampleMax = 2000, eoStopAfterEmpty = 1000} - (genValidPackets (Range.linear 1 10) (Range.linear 1 6) Abort) + (genPackets (Range.linear 1 10) Abort (genValidPacket Gen.enumBounded (Range.linear 1 6))) (exposeClockResetEnable (model 0)) (exposeClockResetEnable (packetDispatcherC fs)) where