diff --git a/nix/overlay.nix b/nix/overlay.nix index ed7842f2f5..8d07568cf1 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -194,7 +194,7 @@ let "clash-testsuite" ../tests "--flag workaround-ghc-mmap-crash" { - inherit (hfinal) clash-cores clash-ghc clash-lib clash-prelude; + inherit (hfinal) clash-ghc clash-lib clash-prelude; }; in unmodified.overrideAttrs (old: { diff --git a/tests/Main.hs b/tests/Main.hs index db0e87fb20..79b902b1c9 100755 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -192,40 +192,6 @@ runClashTest = defaultMain $ clashTestRoot , expectClashFail=Just (def, "Template function for returned False") } ] - , clashTestGroup "Cores" - [ clashTestGroup "Xilinx" - [ clashTestGroup "VIO" - [ runTest "DuplicateOutputNames" def{ - hdlTargets=[VHDL] - , expectClashFail=Just (def, "Tried create a signal called 'a', but identifier generation returned") - } - , runTest "DuplicateInputNames" def{ - hdlTargets=[VHDL] - , expectClashFail=Just (def, "Tried create a signal called 'a', but identifier generation returned") - } - , runTest "DuplicateInputOutputNames" def{ - hdlTargets=[VHDL] - , expectClashFail=Just (def, "Tried create a signal called 'a', but identifier generation returned") - } - , runTest "OutputBusWidthExceeded" def{ - hdlTargets=[VHDL, Verilog, SystemVerilog] - , expectClashFail=Just (def, "Probe signals must be been between 1 and 256 bits wide.") - } - , runTest "OutputProbesExceeded" def{ - hdlTargets=[VHDL, Verilog, SystemVerilog] - , expectClashFail=Just (def, "At most 256 input/output probes are supported.") - } - , runTest "InputBusWidthExceeded" def{ - hdlTargets=[VHDL, Verilog, SystemVerilog] - , expectClashFail=Just (def, "Probe signals must be been between 1 and 256 bits wide.") - } - , runTest "InputProbesExceeded" def{ - hdlTargets=[VHDL, Verilog, SystemVerilog] - , expectClashFail=Just (def, "At most 256 input/output probes are supported.") - } - ] - ] - ] , clashTestGroup "InvalidPrimitive" [ runTest "InvalidPrimitive" def{ hdlTargets=[VHDL] @@ -482,154 +448,6 @@ runClashTest = defaultMain $ clashTestRoot , clashTestGroup "BoxedFunctions" [ runTest "DeadRecursiveBoxed" def{hdlSim=[]} ] - , clashTestGroup "Cores" - [ clashTestGroup "Xilinx" - [ runTest "TdpBlockRam" def - { -- Compiling with VHDL gives: - -- https://github.com/clash-lang/clash-compiler/issues/2446 - hdlTargets = [Verilog] - , hdlLoad = [Vivado] - , hdlSim = [Vivado] - , clashFlags=["-fclash-hdlsyn", "Vivado"] - , buildTargets=BuildSpecific [ "normalWritesTB", "writeEnableWritesTB" ] - } - , let _opts = def{ hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - -- addShortPLTB now segfaults :-( - , buildTargets=BuildSpecific [ "addBasicTB" - , "addEnableTB" - -- , "addShortPLTB" - , "subBasicTB" - , "mulBasicTB" - , "divBasicTB" - , "compareBasicTB" - , "compareEnableTB" - , "fromUBasicTB" - , "fromUEnableTB" - , "fromSBasicTB" - , "fromSEnableTB" - ] - } - in runTest "Floating" _opts - , runTest "XpmCdcArraySingle" $ def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] - } - , runTest "XpmCdcGray" $ def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] - } - , runTest "XpmCdcHandshake" $ def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..6]] - } - , runTest "XpmCdcPulse" $ def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] - } - , runTest "XpmCdcSingle" $ def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] - } - , runTest "XpmCdcSyncRst" $ def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific ["tb" <> show n | n <- [(0::Int)..7]] - } - , runTest "DnaPortE2" def - { hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - } - , clashTestGroup "DcFifo" - [ let _opts = - def{ hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - } - in runTest "Basic" _opts - , let _opts = def{ hdlTargets=[VHDL, Verilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific [ "testBench_17_2" - , "testBench_2_17" - , "testBench_2_2" - ] - } - in runTest "Lfsr" _opts - ] - , let _opts = - def{ hdlTargets=[VHDL, Verilog, SystemVerilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific [ "noInputTrue" - , "noInputFalse" - , "noInputLow" - , "noInputHigh" - , "noInputSigned" - , "noInputUnsigned" - , "noInputBitVector" - , "noInputPair" - , "noInputVec" - , "noInputCustom" - , "noInputNested" - , "singleInputBool" - , "singleInputBit" - , "singleInputSigned" - , "singleInputUnsigned" - , "singleInputBitVector" - , "singleInputPair" - , "singleInputVec" - , "singleInputCustom" - , "singleInputNested" - , "multipleInputs" - , "inputsAndOutputs" - , "withSetName" - , "withSetNameNoResult" - ] - } - in runTest "VIO" _opts - , let _opts = - def{ hdlTargets=[VHDL, Verilog, SystemVerilog] - , hdlLoad=[Vivado] - , hdlSim=[Vivado] - , buildTargets=BuildSpecific [ "testWithDefaultsOne" - , "testWithDefaultsThree" - , "testWithLefts" - , "testWithRights" - , "testWithRightsSameCu" - ] - } - in runTest "Ila" _opts - , let _opts = - def{ hdlTargets=[VHDL, Verilog, SystemVerilog] - , buildTargets=BuildSpecific [ "testWithDefaultsOne" - , "testWithDefaultsThree" - , "testWithLefts" - , "testWithRights" - , "testWithRightsSameCu" - ] - } - in outputTest "Ila" _opts - , outputTest "VIO" def{ - hdlTargets=[VHDL] - , buildTargets=BuildSpecific ["withSetName", "withSetNameNoResult"] - } - , runTest "T2549" def{hdlTargets=[Verilog],hdlSim=[]} - ] - ] , clashTestGroup "CSignal" [ runTest "MAC" def{hdlSim=[]} , runTest "CBlockRamTest" def{hdlSim=[]} diff --git a/tests/clash-testsuite.cabal b/tests/clash-testsuite.cabal index e4d0ec2ee1..8cf7968f29 100644 --- a/tests/clash-testsuite.cabal +++ b/tests/clash-testsuite.cabal @@ -64,7 +64,6 @@ common basic-config -- testsuite to compile, but we do when running it. -- Leaving it out will cause the testsuite to compile -- it anyway so we're better off doing it beforehand. - clash-cores, clash-ghc, clash-lib, clash-prelude diff --git a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputNames.hs b/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputNames.hs deleted file mode 100644 index 74ecc5630b..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputNames.hs +++ /dev/null @@ -1,15 +0,0 @@ -module DuplicateInputNames where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -type Dom = XilinxSystem - -inNames = "a" :> "a" :> Nil -outNames = "b" :> Nil - -topEntity :: - "clk" ::: Clock Dom -> - "in" ::: Signal Dom (Bit, Bit) -> - "out" ::: Signal Dom Bit -topEntity = vioProbe @Dom inNames outNames 0 diff --git a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputOutputNames.hs b/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputOutputNames.hs deleted file mode 100644 index 18ef81f49e..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateInputOutputNames.hs +++ /dev/null @@ -1,15 +0,0 @@ -module DuplicateInputOutputNames where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -type Dom = XilinxSystem - -inNames = "a" :> Nil -outNames = "a" :> Nil - -topEntity :: - "clk" ::: Clock Dom -> - "in" ::: Signal Dom Bit -> - "out" ::: Signal Dom Bit -topEntity = vioProbe @Dom inNames outNames 0 diff --git a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateOutputNames.hs b/tests/shouldfail/Cores/Xilinx/VIO/DuplicateOutputNames.hs deleted file mode 100644 index 78d29cef49..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/DuplicateOutputNames.hs +++ /dev/null @@ -1,14 +0,0 @@ -module DuplicateOutputNames where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -type Dom = XilinxSystem - -inNames = Nil -outNames = "a" :> "a" :> Nil - -topEntity :: - "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Bit, Bit) -topEntity = vioProbe @Dom inNames outNames (0, 0) diff --git a/tests/shouldfail/Cores/Xilinx/VIO/InputBusWidthExceeded.hs b/tests/shouldfail/Cores/Xilinx/VIO/InputBusWidthExceeded.hs deleted file mode 100644 index 7a394e8cd2..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/InputBusWidthExceeded.hs +++ /dev/null @@ -1,15 +0,0 @@ -module InputBusWidthExceeded where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -type Dom = XilinxSystem - -inNames = singleton "probe_in" -outNames = Nil - -topEntity :: - "clk" ::: Clock Dom -> - "in" ::: Signal Dom (BitVector 257) -> - "out" ::: Signal Dom () -topEntity = vioProbe @Dom inNames outNames () diff --git a/tests/shouldfail/Cores/Xilinx/VIO/InputProbesExceeded.hs b/tests/shouldfail/Cores/Xilinx/VIO/InputProbesExceeded.hs deleted file mode 100644 index edf84679d2..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/InputProbesExceeded.hs +++ /dev/null @@ -1,17 +0,0 @@ -module InputProbesExceeded where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -import qualified Data.List as L - -type Dom = XilinxSystem - -inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0::Int, 1..256])) -outNames = Nil - -topEntity :: - "clk" ::: Clock Dom -> - "in" ::: Signal Dom (Vec 257 Bool) -> - "out" ::: Signal Dom () -topEntity = vioProbe @Dom inNames outNames () diff --git a/tests/shouldfail/Cores/Xilinx/VIO/OutputBusWidthExceeded.hs b/tests/shouldfail/Cores/Xilinx/VIO/OutputBusWidthExceeded.hs deleted file mode 100644 index 44b89c696c..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/OutputBusWidthExceeded.hs +++ /dev/null @@ -1,14 +0,0 @@ -module OutputBusWidthExceeded where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -type Dom = XilinxSystem - -inNames = Nil -outNames = singleton "probe_out" - -topEntity :: - "clk" ::: Clock Dom -> - "out" ::: Signal Dom (BitVector 257) -topEntity = vioProbe @Dom inNames outNames 0 diff --git a/tests/shouldfail/Cores/Xilinx/VIO/OutputProbesExceeded.hs b/tests/shouldfail/Cores/Xilinx/VIO/OutputProbesExceeded.hs deleted file mode 100644 index 8ccefb5657..0000000000 --- a/tests/shouldfail/Cores/Xilinx/VIO/OutputProbesExceeded.hs +++ /dev/null @@ -1,16 +0,0 @@ -module OutputProbesExceeded where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO - -import qualified Data.List as L - -type Dom = XilinxSystem - -inNames = Nil -outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0::Int, 1..256])) - -topEntity :: - "clk" ::: Clock Dom -> - "out" ::: Signal Dom (Vec 257 Bit) -topEntity = vioProbe @Dom inNames outNames (replicate (SNat @257) low) diff --git a/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs b/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs deleted file mode 100644 index 9a760bbb89..0000000000 --- a/tests/shouldwork/Cores/Xilinx/DcFifo/Basic.hs +++ /dev/null @@ -1,140 +0,0 @@ -{-# LANGUAGE CPP #-} - -module Basic where - -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench -import Clash.Sized.Internal.BitVector (undefined#) -import Clash.Cores.Xilinx.DcFifo - --- Configurables -type Overfill = 4 -type DepthParam = 4 -type ActualDepth = 15 --- End of configurables - -type TotalElems = ActualDepth + Overfill -type Elem = Index TotalElems - -data FSM - = Push (Index TotalElems) - | StartRead - | Pop (Index TotalElems) - | Done - deriving (Show, Generic, NFDataX) - -topEntity :: - Clock XilinxSystem -> - Reset XilinxSystem -> - Signal XilinxSystem (Maybe Elem) -> - Signal XilinxSystem Bool -> - ( FifoOut XilinxSystem XilinxSystem DepthParam Elem - , FifoOut XilinxSystem XilinxSystem DepthParam Elem - ) -topEntity clk rst writeData rEnable = - ( dcFifo minOpt clk rst clk rst writeData rEnable - , dcFifo maxOpt clk rst clk rst writeData rEnable - ) - where - minOpt = DcConfig - { dcDepth=SNat - , dcReadDataCount=False - , dcWriteDataCount=False - , dcOverflow=False - , dcUnderflow=False - } - maxOpt = DcConfig - { dcDepth=SNat - , dcReadDataCount=True - , dcWriteDataCount=True - , dcOverflow=True - , dcUnderflow=True - } --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE topEntity #-} - -testBench :: - Signal XilinxSystem Bool -testBench = done - where - fsmOut = let (s', o) = unbundle $ fsm <$> delay clk en (Push 0) s' - in o - (minOut, maxOut) = - topEntity clk noReset (fWriteData <$> fsmOut) (fREnable <$> fsmOut) - done = - register clk noReset en False - $ assertBitVector clk noReset "FIFO min full" - (pack <$> isFull minOut) (fExpectedFull <$> fsmOut) - $ assertBitVector clk noReset "FIFO max full" - (pack <$> isFull maxOut) (fExpectedFull <$> fsmOut) - $ assertBitVector clk noReset "FIFO max overflow" - (pack <$> isOverflow maxOut) (fExpectedOverflow <$> fsmOut) - $ assertBitVector clk noReset "FIFO min empty" - (pack <$> isEmpty minOut) (fExpectedEmpty <$> fsmOut) - $ assertBitVector clk noReset "FIFO max empty" - (pack <$> isEmpty maxOut) (fExpectedEmpty <$> fsmOut) - $ assertBitVector clk noReset "FIFO max underflow" - (pack <$> isUnderflow maxOut) (fExpectedUnderflow <$> fsmOut) - $ assertBitVector clk noReset "FIFO min data out" - (pack <$> fifoData minOut) (fExpectedData <$> fsmOut) - $ assertBitVector clk noReset "FIFO max data out" - (pack <$> fifoData maxOut) (fExpectedData <$> fsmOut) - (fDone <$> fsmOut) - clk = tbClockGen (not <$> done) - en = enableGen --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE testBench #-} - -data FsmOut = FsmOut - { fDone :: Bool - , fWriteData :: Maybe Elem - , fREnable :: Bool - , fExpectedFull :: BitVector 1 - , fExpectedOverflow :: BitVector 1 - , fExpectedEmpty :: BitVector 1 - , fExpectedUnderflow :: BitVector 1 - , fExpectedData :: BitVector (BitSize Elem) - } - -defFsmOut :: FsmOut -defFsmOut = - FsmOut{ fDone=False - , fWriteData=Nothing - , fREnable=False - , fExpectedFull=undefined# - , -- Assert overflow false by default - fExpectedOverflow=pack False - , fExpectedEmpty=undefined# - , -- Assert underflow false by default - fExpectedUnderflow=pack False - , fExpectedData=undefined# - } - -fsm :: - FSM -> - (FSM, FsmOut) -fsm (Push i) = - let s' = if (i == maxBound) then StartRead else Push (i + 1) - o = defFsmOut{ fWriteData=Just i - , fExpectedFull=pack (i >= actualDepth) - , fExpectedOverflow=pack (i > actualDepth) - } - in (s', o) -fsm StartRead = (Pop 0, defFsmOut{ fREnable=True - , fExpectedOverflow=pack True - }) -fsm (Pop i) = - let isLast = i == maxBound - s' = if isLast then Done else Pop (i + 1) - underflow = i >= actualDepth - o = defFsmOut{ fREnable=not isLast - , fExpectedEmpty=pack (i >= actualDepth - 1) - , fExpectedUnderflow=pack underflow - , fExpectedData=if underflow then undefined# - else pack i - } - in (s', o) -fsm Done = (Done, defFsmOut{fDone=True, fExpectedEmpty=pack True}) - -actualDepth :: Index TotalElems -actualDepth = natToNum @ActualDepth diff --git a/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs b/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs deleted file mode 100644 index 0ee09857fc..0000000000 --- a/tests/shouldwork/Cores/Xilinx/DcFifo/Lfsr.hs +++ /dev/null @@ -1,203 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# OPTIONS_GHC -Wno-orphans #-} -module Lfsr where - -import Clash.Explicit.Prelude -import Clash.Cores.Xilinx.DcFifo -import Clash.Explicit.Testbench -import Data.Maybe (isJust) - -type ReadLastCycle = Bool -type Stall = Bool -type ExpectedToRead n = BitVector n -type UnexpectedRead = Bool - -createDomain vXilinxSystem{vName="Dom2", vPeriod=hzToPeriod 2e7} -createDomain vXilinxSystem{vName="Dom3", vPeriod=hzToPeriod 3e7} -createDomain vXilinxSystem{vName="Dom17", vPeriod=hzToPeriod 17e7} - --- | Produce a 'Just' when predicate is True, else Nothing -orNothing :: Bool -> a -> Maybe a -orNothing True a = Just a -orNothing False _ = Nothing - -lfsrF :: - KnownDomain dom => - Clock dom -> Reset dom -> Enable dom -> - BitVector 16 -> - Signal dom Bit -lfsrF clk rst ena seed = msb <$> r - where - r = register clk rst ena seed (lfsrF' <$> r) - - lfsrF' :: BitVector 16 -> BitVector 16 - lfsrF' s = pack lfsrFeedback ++# slice d15 d1 s - where - five, three, two, zero :: Unsigned 16 - (five, three, two, zero) = (5, 3, 2, 0) - lfsrFeedback = s ! five `xor` s ! three `xor` s ! two `xor` s ! zero --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE lfsrF #-} - -fifoSampler :: - KnownDomain dom => - Clock dom -> Reset dom -> Enable dom -> - -- | Stall circuit? For this test case, this signal comes from 'lfsrF' - Signal dom Stall -> - -- | Signals from FIFO - Signal dom (Empty, DataCount depth, a) -> - -- | Maybe output read from FIFO - Signal dom (Bool, Maybe a) -fifoSampler clk rst ena stalls inps = - mealy clk rst ena go False (bundle (stalls, inps)) - where - go :: - ReadLastCycle -> - (Stall, (Empty, DataCount depth, a)) -> - (ReadLastCycle, (Bool, Maybe a)) - go readLastCycle (stall, (fifoEmpty, _dataCount, readData)) = (readNow, (readNow, maybeData)) - where - maybeData = readLastCycle `orNothing` readData - readNow = not stall && not fifoEmpty --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE fifoSampler #-} - --- | Drives Xilinx FIFO with an ascending sequence of 'BitVector's. Stalls --- intermittently based on stall input. -fifoDriver :: - forall a dom depth . - ( KnownDomain dom - , NFDataX a - , Enum a - , Num a - ) => - Clock dom -> Reset dom -> Enable dom -> - -- | Stall circuit? For this test case, this signal comes from 'lfsrF' - Signal dom Stall -> - -- | Signals from FIFO - Signal dom (Full, DataCount depth) -> - -- | Maybe write input to FIFO - Signal dom (Maybe a) -fifoDriver clk rst ena stalls inps = - mealyB clk rst ena go 0 (stalls, inps) - where - go :: - a -> - (Stall, (Full, DataCount depth)) -> - (a, Maybe a) - go n0 (stall, (full, _dataCount)) = (n1, maybeWrite) - where - maybeWrite = willWrite `orNothing` n0 - willWrite = not stall && not full - n1 = if willWrite then succ n0 else n0 - -type ConfiguredFifo a read write = - Clock write -> - Reset write -> - Clock read -> - Reset read -> - - -- | Write data - Signal write (Maybe a) -> - -- | Read enable - Signal read Bool -> - FifoOut read write 4 a - -mkTestBench :: - forall a read write. - ( Num a - , Enum a - , NFDataX a - , Ord a - , ShowX a - , KnownDomain write - , KnownDomain read - ) => - ConfiguredFifo a read write -> - Signal read Bool -mkTestBench cFifo = done - where - (rClk, wClk) = biTbClockGen (not <$> done) - - rEna = enableGen - wEna = enableGen - - -- Driver - wLfsr = bitToBool <$> lfsrF wClk noReset wEna 0xDEAD - writeData = fifoDriver wClk noReset wEna wLfsr (bundle (isFull, writeCount)) - - -- Sampler - rLfsr = bitToBool <$> lfsrF rClk noReset rEna 0xBEEF - (readEnable, maybeReadData) = - unbundle $ - fifoSampler rClk noReset rEna rLfsr (bundle (isEmpty, readCount, fifoData)) - - FifoOut{isFull, writeCount, isEmpty, readCount, fifoData} = - cFifo wClk noReset rClk noReset writeData readEnable - - done = fifoVerifier rClk noReset rEna maybeReadData -{-# INLINE mkTestBench #-} - -fifoVerifier :: - forall a dom . - ( KnownDomain dom - , Ord a - , Num a - , NFDataX a - , ShowX a - ) => - Clock dom -> Reset dom -> Enable dom -> - Signal dom (Maybe a) -> - Signal dom Bool -fifoVerifier clk rst ena actual = done0 - where - expected = regEn clk rst ena 0 (isJust <$> actual) $ expected + 1 - samplesDone = expected .>. 100 - stuckCnt :: Signal dom (Index 25000) - stuckCnt = regEn clk rst ena 0 (not <$> stuck) $ stuckCnt + 1 - stuck = stuckCnt .==. pure maxBound - -- Delay one cycle so assertion definitely triggers before stopping simulation - done = register clk rst ena False $ samplesDone .||. stuck - expected0 = liftA2 (<$) expected actual - done0 = - assert clk rst "Doesn't time out" stuck (pure False) $ - assert clk rst "fifoVerifier" actual expected0 done --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE fifoVerifier #-} - -topEntity_17_2 :: ConfiguredFifo (BitVector 16) Dom17 Dom2 -topEntity_17_2 = dcFifo defConfig --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE topEntity_17_2 #-} -{-# ANN topEntity_17_2 (defSyn "topEntity_17_2") #-} - -testBench_17_2 :: Signal Dom17 Bool -testBench_17_2 = mkTestBench topEntity_17_2 --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE testBench_17_2 #-} -{-# ANN testBench_17_2 (TestBench 'topEntity_17_2) #-} - -topEntity_2_17 :: ConfiguredFifo (BitVector 16) Dom2 Dom17 -topEntity_2_17 = dcFifo defConfig --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE topEntity_2_17 #-} -{-# ANN topEntity_2_17 (defSyn "topEntity_2_17") #-} - -testBench_2_17 :: Signal Dom2 Bool -testBench_2_17 = mkTestBench topEntity_2_17 --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE testBench_2_17 #-} -{-# ANN testBench_2_17 (TestBench 'topEntity_2_17) #-} - -topEntity_2_2 :: ConfiguredFifo (Unsigned 16) Dom2 Dom2 -topEntity_2_2 = dcFifo defConfig --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE topEntity_2_2 #-} -{-# ANN topEntity_2_2 (defSyn "topEntity_2_2") #-} - -testBench_2_2 :: Signal Dom2 Bool -testBench_2_2 = mkTestBench topEntity_2_2 --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE testBench_2_2 #-} -{-# ANN testBench_2_2 (TestBench 'topEntity_2_2) #-} diff --git a/tests/shouldwork/Cores/Xilinx/DnaPortE2.hs b/tests/shouldwork/Cores/Xilinx/DnaPortE2.hs deleted file mode 100644 index af95000160..0000000000 --- a/tests/shouldwork/Cores/Xilinx/DnaPortE2.hs +++ /dev/null @@ -1,25 +0,0 @@ -{-# LANGUAGE CPP #-} - -module DnaPortE2 where - -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench -import Clash.Cores.Xilinx.Unisim.DnaPortE2 - -topEntity :: - Clock XilinxSystem -> - Reset XilinxSystem -> - Signal XilinxSystem (Maybe (BitVector 96)) -topEntity clk rst = readDnaPortE2 clk rst enableGen simDna2 -{-# CLASH_OPAQUE topEntity #-} - -testBench :: Signal XilinxSystem Bool -testBench = done - where - expected = - ($(listToVecTH (sampleN 200 $ - readDnaPortE2 (clockGen @XilinxSystem) noReset enableGen simDna2))) - done = outputVerifier' clk rst expected (topEntity clk rst) - clk = tbClockGen (not <$> done) - rst = noReset -{-# CLASH_OPAQUE testBench #-} diff --git a/tests/shouldwork/Cores/Xilinx/Floating.hs b/tests/shouldwork/Cores/Xilinx/Floating.hs deleted file mode 100644 index 482799fe67..0000000000 --- a/tests/shouldwork/Cores/Xilinx/Floating.hs +++ /dev/null @@ -1,429 +0,0 @@ -{-| -Copyright : (C) 2021-2022, QBayLogic B.V., - 2022 , Google Inc., -License : BSD2 (see the file LICENSE) -Maintainer : QBayLogic B.V. --} - -{-# LANGUAGE CPP #-} - -{-# OPTIONS_GHC -fconstraint-solver-iterations=10 -Wall -Werror #-} - -module Floating where - -import Clash.Prelude -import qualified Clash.Explicit.Prelude as CEP -import qualified Clash.Signal.Delayed as D -import Clash.Explicit.Testbench - -import qualified Prelude as P -import Numeric (showHex) - -import qualified Clash.Cores.Xilinx.Floating as F - -import Floating.Annotations -import Floating.TH - -newtype FloatVerifier = FloatVerifier Float - deriving (Generic) - deriving anyclass BitPack - -instance Eq FloatVerifier where - (FloatVerifier x) == (FloatVerifier y) = pack x == pack y - -instance ShowX FloatVerifier where - showsPrecX = showsPrecXWith showsPrec - -instance Show FloatVerifier where - showsPrec = floatVerifierShowsPrec - -floatVerifierShowsPrec - :: Int - -> FloatVerifier - -> ShowS -floatVerifierShowsPrec _ (FloatVerifier x) - | isNaN x = nanSign . nanString . showHex payload . (')':) - | otherwise = shows x - where - nanSign | msb (pack x) == 0 = ('+':) - | otherwise = ('-':) - nanString - | testBit (pack x) 22 = ("qNaN(0x" P.++) - | otherwise = ("sNaN(0x" P.++) - payload = truncateB $ pack x :: BitVector 22 - -playSampleRom - :: forall n a dom - . ( KnownDomain dom - , KnownNat n - , BitPack a - , 1 <= n - ) - => Clock dom - -> Reset dom - -> MemBlob n (BitSize a) - -> (Signal dom Bool, Signal dom a) -playSampleRom clk rst content = (done, out) - where - out = unpack . asyncRomBlob content <$> cnt - done = CEP.register clk rst enableGen False $ (== maxBound) <$> cnt - cnt :: Signal dom (Index n) - cnt = CEP.register clk rst enableGen 0 $ satSucc SatBound <$> cnt - -basicBinaryTB - :: forall n d x y z - . ( KnownNat n - , KnownNat d - , Eq z, ShowX z - , 1 <= n - ) - => ( Clock XilinxSystem - -> DSignal XilinxSystem 0 x - -> DSignal XilinxSystem 0 y - -> DSignal XilinxSystem d z - ) - -> z - -> Vec n (x, y, z) - -> Signal XilinxSystem Bool -basicBinaryTB comp zDef samples = done - where - (inputX, inputY, expectedOutput) = unzip3 samples - testInputX = fromSignal $ stimuliGenerator clk rst inputX - testInputY = fromSignal $ stimuliGenerator clk rst inputY - expectOutput = outputVerifier' clk rst (repeat @d zDef ++ expectedOutput) - done = - expectOutput . ignoreFor clk rst en (SNat @d) zDef - . toSignal $ comp clk testInputX testInputY - clk = tbClockGen (not <$> done) - rst = resetGen - en = enableGen -{-# INLINE basicBinaryTB #-} - -basicRomTB - :: forall d n x y z - . ( KnownNat n - , KnownNat d - , BitPack x - , BitPack y - , Eq z, ShowX z, BitPack z - , 1 <= n - ) - => ( Clock XilinxSystem - -> DSignal XilinxSystem 0 x - -> DSignal XilinxSystem 0 y - -> DSignal XilinxSystem d z - ) - -> z - -> MemBlob n (BitSize (x, y, z)) - -> Signal XilinxSystem Bool -basicRomTB comp resDef sampleBlob = done - where - (done0, samples) = playSampleRom clk rst sampleBlob - (inputX, inputY, expectedOutput) = unbundle samples - -- Only assert while not finished - done = mux done0 done0 - $ assert clk rst "basicRomTB" out expectedOutput - done0 - out = - ignoreFor clk rst en (SNat @d) resDef - . toSignal $ comp clk (fromSignal inputX) (fromSignal inputY) - clk = tbClockGen (not <$> done) - rst = resetGen - en = enableGen -{-# INLINE basicRomTB #-} - -addBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem F.AddDefDelay Float -addBasic clk x y = withClock clk $ withEnable enableGen $ F.add x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE addBasic #-} -{-# ANN addBasic (binaryTopAnn "addBasic") #-} - -addBasicTB :: Signal XilinxSystem Bool -addBasicTB = - basicRomTB - (\clk a b -> FloatVerifier <$> addBasic clk a b) - (FloatVerifier 0.0) - $(memBlobTH Nothing addBasicSamples) -{-# ANN addBasicTB (TestBench 'addBasic) #-} - -addEnable - :: Clock XilinxSystem - -> Enable XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 11 Float -addEnable clk en x y = withClock clk $ withEnable en $ F.add x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE addEnable #-} -{-# ANN addEnable (binaryEnTopAnn "addEnable") #-} - -addEnableTB :: Signal XilinxSystem Bool -addEnableTB = done - where - testInput = - fromSignal $ stimuliGenerator clk rst $(listToVecTH [1 :: Float .. 25]) - en = - toEnable $ stimuliGenerator clk rst - ( (replicate d11 True ++ replicate d4 True ++ replicate d4 False) - :< True) - expectedOutput = - replicate d11 0 - ++ $(listToVecTH . P.map (\i -> i + i) $ - [1 :: Float .. 4] - -- Stall for four cycles - P.++ P.replicate 4 5 - -- Still in the pipeline (11 deep) from before the stall. - P.++ P.take 11 [5 .. 25] - -- We "lose" four samples of what remains due to not being enabled - -- for those inputs. - P.++ P.drop 4 (P.drop 11 [5 .. 25]) - ) - expectOutput = - outputVerifier' clk rst expectedOutput - done = - expectOutput . ignoreFor clk rst enableGen d11 0 - . toSignal $ addEnable clk en testInput testInput - clk = tbClockGen (not <$> done) - rst = resetGen -{-# ANN addEnableTB (TestBench 'addEnable) #-} - -addShortPL - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 6 Float -addShortPL clk x y = - withClock clk $ withEnable enableGen $ F.addWith F.defConfig x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE addShortPL #-} -{-# ANN addShortPL (binaryTopAnn "addShortPL") #-} - -addShortPLTB :: Signal XilinxSystem Bool -addShortPLTB = - basicBinaryTB addShortPL 0.0 - $(listToVecTH [ (1, 4, 5) :: (Float, Float, Float) - , (2, 5, 7) - , (3, 6, 9) - ]) -{-# ANN addShortPLTB (TestBench 'addShortPL) #-} - -subBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem F.SubDefDelay Float -subBasic clk x y = withClock clk $ withEnable enableGen $ F.sub x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE subBasic #-} -{-# ANN subBasic (binaryTopAnn "subBasic") #-} - -subBasicTB :: Signal XilinxSystem Bool -subBasicTB = - basicRomTB - (\clk a b -> FloatVerifier <$> subBasic clk a b) - (FloatVerifier 0.0) - $(memBlobTH Nothing subBasicSamples) -{-# ANN subBasicTB (TestBench 'subBasic) #-} - -mulBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem F.MulDefDelay Float -mulBasic clk x y = withClock clk $ withEnable enableGen $ F.mul x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE mulBasic #-} -{-# ANN mulBasic (binaryTopAnn "mulBasic") #-} - -mulBasicTB :: Signal XilinxSystem Bool -mulBasicTB = - basicRomTB - (\clk a b -> FloatVerifier <$> mulBasic clk a b) - (FloatVerifier 0.0) - $(memBlobTH Nothing mulBasicSamples) -{-# ANN mulBasicTB (TestBench 'mulBasic) #-} - -divBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem F.DivDefDelay Float -divBasic clk x y = withClock clk $ withEnable enableGen $ F.div x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE divBasic #-} -{-# ANN divBasic (binaryTopAnn "divBasic") #-} - -divBasicTB :: Signal XilinxSystem Bool -divBasicTB = - basicRomTB - (\clk a b -> FloatVerifier <$> divBasic clk a b) - (FloatVerifier 0.0) - $(memBlobTH Nothing divBasicSamples) -{-# ANN divBasicTB (TestBench 'divBasic) #-} - -compareBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem F.CompareDefDelay F.Ordering -compareBasic clk x y = - withClock clk $ withEnable enableGen $ F.compare x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE compareBasic #-} -{-# ANN compareBasic (binaryTopAnn "compareBasic") #-} - -compareBasicTB :: Signal XilinxSystem Bool -compareBasicTB = - basicRomTB compareBasic F.NaN $(memBlobTH Nothing compareBasicSamples) -{-# ANN compareBasicTB (TestBench 'compareBasic) #-} - -compareEnable - :: Clock XilinxSystem - -> Enable XilinxSystem - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem 0 Float - -> DSignal XilinxSystem F.CompareDefDelay F.Ordering -compareEnable clk en x y = withClock clk $ withEnable en $ F.compare x y --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE compareEnable #-} -{-# ANN compareEnable (binaryEnTopAnn "compareEnable") #-} - -compareEnableTB :: Signal XilinxSystem Bool -compareEnableTB = done - where - done = outputVerifier' clk rst $(listToVecTH compareFloatsEnableExpected) actual1 - - actual1 = ignoreFor clk rst enableGen d6 F.EQ (D.toSignal actual0) - actual0 = compareEnable clk ena (D.fromSignal testInputA) (D.fromSignal testInputB) - - clk = tbClockGen (not <$> done) - rst = resetGen - ena = toEnable $ CEP.stimuliGenerator clk rst $(listToVecTH compareFloatsEnableInput) - - testInputA = CEP.stimuliGenerator clk rst $(listToVecTH compareFloatsEnableInputA) - testInputB = CEP.stimuliGenerator clk rst $(listToVecTH compareFloatsEnableInputB) -{-# ANN compareEnableTB (TestBench 'compareEnable) #-} - -fromUBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 (Unsigned 32) - -> DSignal XilinxSystem F.FromU32DefDelay Float -fromUBasic clk x = withClock clk $ withEnable enableGen $ F.fromU32 x --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE fromUBasic #-} -{-# ANN fromUBasic (unaryTopAnn "fromUBasic") #-} - -fromUBasicTB :: Signal XilinxSystem Bool -fromUBasicTB = done - where - (done0, samples) = - playSampleRom clk rst $(memBlobTH Nothing fromUBasicSamples) - (input, expectedOutput) = unbundle samples - -- Only assert while not finished - done = mux done0 done0 $ - assert clk rst "fromUBasicTB" out expectedOutput done0 - out = ignoreFor clk rst en (SNat @F.FromU32DefDelay) 0 . toSignal . - fromUBasic clk $ fromSignal input - clk = tbClockGen (not <$> done) - rst = resetGen - en = enableGen -{-# ANN fromUBasicTB (TestBench 'fromUBasic) #-} - -fromUEnable - :: Clock XilinxSystem - -> Enable XilinxSystem - -> DSignal XilinxSystem 0 (Unsigned 32) - -> DSignal XilinxSystem 5 Float -fromUEnable clk en x = withClock clk $ withEnable en $ F.fromU32 x --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE fromUEnable #-} -{-# ANN fromUEnable (unaryEnTopAnn "fromUEnable") #-} - -fromUEnableTB :: Signal XilinxSystem Bool -fromUEnableTB = done - where - testInput = fromSignal $ - stimuliGenerator clk rst $(listToVecTH [1 :: Unsigned 32 .. 20]) - en = toEnable $ stimuliGenerator clk rst - ((replicate d5 True ++ replicate d4 True ++ replicate d4 False) :< True) - expectedOutput = replicate d5 0 ++ - $(listToVecTH $ - [1 :: Float .. 4] - -- Stall for four cycles - <> P.replicate 4 5 - -- Still in the pipeline (5 deep) from before the stall. - <> P.take 5 [5 .. 20] - -- We "lose" four samples of what remains due to not being enabled - -- for those inputs. - <> P.drop 4 (P.drop 5 [5 .. 20]) - ) - expectOutput = outputVerifier' clk rst expectedOutput - done = expectOutput . ignoreFor clk rst enableGen d5 0 . toSignal $ - fromUEnable clk en testInput - clk = tbClockGen (not <$> done) - rst = resetGen -{-# ANN fromUEnableTB (TestBench 'fromUEnable) #-} - -fromSBasic - :: Clock XilinxSystem - -> DSignal XilinxSystem 0 (Signed 32) - -> DSignal XilinxSystem F.FromS32DefDelay Float -fromSBasic clk x = withClock clk $ withEnable enableGen $ F.fromS32 x --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE fromSBasic #-} -{-# ANN fromSBasic (unaryTopAnn "fromSBasic") #-} - -fromSBasicTB :: Signal XilinxSystem Bool -fromSBasicTB = done - where - (done0, samples) = - playSampleRom clk rst $(memBlobTH Nothing fromSBasicSamples) - (input, expectedOutput) = unbundle samples - -- Only assert while not finished - done = mux done0 done0 $ - assert clk rst "fromSBasicTB" out expectedOutput done0 - out = ignoreFor clk rst en (SNat @F.FromS32DefDelay) 0 . toSignal . - fromSBasic clk $ fromSignal input - clk = tbClockGen (not <$> done) - rst = resetGen - en = enableGen -{-# ANN fromSBasicTB (TestBench 'fromSBasic) #-} - -fromSEnable - :: Clock XilinxSystem - -> Enable XilinxSystem - -> DSignal XilinxSystem 0 (Signed 32) - -> DSignal XilinxSystem 6 Float -fromSEnable clk en x = withClock clk $ withEnable en $ F.fromS32 x --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE fromSEnable #-} -{-# ANN fromSEnable (unaryEnTopAnn "fromSEnable") #-} - -fromSEnableTB :: Signal XilinxSystem Bool -fromSEnableTB = done - where - testInput = fromSignal $ - stimuliGenerator clk rst $(listToVecTH [1 :: Signed 32 .. 21]) - en = toEnable $ stimuliGenerator clk rst - ((replicate d6 True ++ replicate d4 True ++ replicate d4 False) :< True) - expectedOutput = replicate d6 0 ++ - $(listToVecTH $ - [1 :: Float .. 4] - -- Stall for four cycles - <> P.replicate 4 5 - -- Still in the pipeline (6 deep) from before the stall. - <> P.take 6 [5 .. 21] - -- We "lose" four samples of what remains due to not being enabled - -- for those inputs. - <> P.drop 4 (P.drop 6 [5 .. 21]) - ) - expectOutput = outputVerifier' clk rst expectedOutput - done = expectOutput . ignoreFor clk rst enableGen d6 0 . toSignal $ - fromSEnable clk en testInput - clk = tbClockGen (not <$> done) - rst = resetGen -{-# ANN fromSEnableTB (TestBench 'fromSEnable) #-} diff --git a/tests/shouldwork/Cores/Xilinx/Floating/Annotations.hs b/tests/shouldwork/Cores/Xilinx/Floating/Annotations.hs deleted file mode 100644 index fc17a83d67..0000000000 --- a/tests/shouldwork/Cores/Xilinx/Floating/Annotations.hs +++ /dev/null @@ -1,58 +0,0 @@ -{-| -Copyright : (C) 2021, QBayLogic B.V., - 2022, Google Inc., -License : BSD2 (see the file LICENSE) -Maintainer : QBayLogic B.V. --} - -module Floating.Annotations where - -import Clash.Prelude - -binaryTopAnn :: String -> TopEntity -binaryTopAnn name = - Synthesize - { t_name = name - , t_inputs = - [ PortName "clk" - , PortName "x" - , PortName "y" - ] - , t_output = PortName "result" - } - -binaryEnTopAnn :: String -> TopEntity -binaryEnTopAnn name = - Synthesize - { t_name = name - , t_inputs = - [ PortName "clk" - , PortName "en" - , PortName "x" - , PortName "y" - ] - , t_output = PortName "result" - } - -unaryTopAnn :: String -> TopEntity -unaryTopAnn name = - Synthesize - { t_name = name - , t_inputs = - [ PortName "clk" - , PortName "x" - ] - , t_output = PortName "result" - } - -unaryEnTopAnn :: String -> TopEntity -unaryEnTopAnn name = - Synthesize - { t_name = name - , t_inputs = - [ PortName "clk" - , PortName "en" - , PortName "x" - ] - , t_output = PortName "result" - } diff --git a/tests/shouldwork/Cores/Xilinx/Floating/TH.hs b/tests/shouldwork/Cores/Xilinx/Floating/TH.hs deleted file mode 100644 index a1e35411d7..0000000000 --- a/tests/shouldwork/Cores/Xilinx/Floating/TH.hs +++ /dev/null @@ -1,731 +0,0 @@ -{-| -Copyright : (C) 2021-2022, QBayLogic B.V., - 2022 , Google Inc., -License : BSD2 (see the file LICENSE) -Maintainer : QBayLogic B.V. --} - -{-# OPTIONS_GHC -Wall -Werror #-} - -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} - -module Floating.TH where - -import Clash.Prelude (natToNum, unpack, Signed, Unsigned) - -import Prelude -import Numeric.IEEE - (epsilon, infinity, maxFinite, minDenormal, minNormal) - -import Clash.Cores.Xilinx.Floating as F -import Clash.Cores.Xilinx.Floating.Internal as F - --- | For @compareEnableTB@. Obtained by running an RNG. -compareFloatsEnableInputA :: [Float] -compareFloatsEnableInputA = - [ 63, 73, 85, 68, 14, 36, 52, 38, 97, 60, 80, 10, 94, 58, 47, 59, 70, 9, 64 - , 79, 5, 49, 88, 93, 43, 90, 99, 56, 98, 12, 11, 20, 100, 57, 37, 33, 74, 83 - , 19, 84, 95, 53, 34, 89, 75, 55, 76, 44, 18, 28 - ] - --- | For @compareEnableTB@. Obtained by running an RNG. -compareFloatsEnableInputB :: [Float] -compareFloatsEnableInputB = - [ 74, 62, 11, 12, 41, 10, 76, 90, 26, 93, 43, 29, 33, 79, 77, 80, 57, 70, 22 - , 19, 14, 8, 37, 2, 85, 89, 36, 86, 91, 17, 53, 4, 25, 97, 72, 24, 50, 9, 99 - , 95, 65, 30, 63, 7, 92, 15, 28, 82, 87, 84 - ] - --- | For @compareEnableTB@. -compareFloatsEnableInput :: [Bool] -compareFloatsEnableInput = map (<= 50) compareFloatsEnableInputA - --- | For @compareEnableTB@. Obtained by sampling Haskell model. -compareFloatsEnableExpected :: [F.Ordering] -compareFloatsEnableExpected = - [ F.EQ, F.EQ, F.EQ, F.EQ, F.EQ, F.EQ -- First samples undefined, replaced by EQ in TB - , F.LT, F.LT, F.GT, F.GT, F.GT, F.GT, F.LT, F.LT, F.LT, F.LT, F.LT, F.LT, F.LT - , F.LT, F.LT, F.LT, F.LT, F.LT, F.LT, F.GT, F.GT, F.GT, F.GT, F.GT, F.LT, F.LT - , F.LT, F.LT, F.LT, F.GT, F.LT, F.LT, F.LT, F.GT, F.GT, F.GT, F.GT, F.LT, F.LT - , F.LT, F.LT, F.LT, F.LT, F.LT - ] - -delayOutput - :: Int - -> a - -> [(Float, Float, a)] - -> [(Float, Float, a)] -delayOutput d aDef es = zip3 xs ys rs - where - (xs0, ys0, rs0) = unzip3 es - xs = xs0 ++ repeat (last xs0) - ys = ys0 ++ repeat (last ys0) - rs = replicate d aDef ++ rs0 - -addBasicSamples :: [(Float, Float, Float)] -addBasicSamples = - delayOutput (natToNum @F.AddDefDelay) 0.0 $ - [ (1, 4, 5) - , (2, 5, 7) - , (3, 6, 9) - ] - ++ addSubBasicSamples - ++ cartesianProductTest model interesting interesting - ++ nanTest - where - model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x + y - -subBasicSamples :: [(Float, Float, Float)] -subBasicSamples = - delayOutput (natToNum @F.SubDefDelay) 0.0 $ - [ (1, 6, -5) - , (2, 5, -3) - , (3, 4, -1) - ] - ++ map (\(a,b,c) -> (a, negate b, c)) addSubBasicSamples - ++ cartesianProductTest model interesting interesting - ++ nanTest - where - model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x - y - -addSubBasicSamples :: [(Float, Float, Float)] -addSubBasicSamples = - [ -- Subnormal positive number is conditioned to plus zero - -- - -- The unconditioned result is the subnormal of largest magnitude - ( -minNormal - , minNormal + maxDenormal - , 0 - ) - -- The unconditioned result is the subnormal of smallest magnitude - , ( -minNormal - , minNormal + minDenormal - , 0 - ) - -- Subnormal negative number is conditioned to minus zero - -- - -- The unconditioned result is the subnormal of largest magnitude - , ( minNormal - , -minNormal - maxDenormal - , -0 - ) - -- The unconditioned result is the subnormal of smallest magnitude - , ( minNormal - , -minNormal - minDenormal - , -0 - ) - -- Subnormals on input are conditioned to zero - -- - -- The result would normally be the smallest normal number, but due to - -- conditioning it is zero. - , ( maxDenormal - , minDenormal - , 0 - ) - -- The result would normally be almost twice the smallest normal number, - -- well within normal range, but due to conditioning it is again zero. - , ( maxDenormal - , maxDenormal - , 0 - ) - -- The result would normally be exact, but the second input is conditioned - -- to zero. - , ( minNormal - , minDenormal - , minNormal - ) - -- The result would normally be exact, but the first input is conditioned - -- to zero. - , ( maxDenormal - , minNormal - , minNormal - ) - -- Subnormals on input are conditioned to zero, negative version - -- - -- The result would normally be the normal number of smallest magnitude, - -- but due to conditioning it is zero. - , ( -maxDenormal - , -minDenormal - , -0 - ) - -- The result would normally be almost twice the normal number of smallest - -- magnitude, well within normal range, but due to conditioning it is again - -- zero. - , ( -maxDenormal - , -maxDenormal - , -0 - ) - -- The result would normally be exact, but the second input is conditioned - -- to zero. - , ( -minNormal - , -minDenormal - , -minNormal - ) - -- The result would normally be exact, but the first input is conditioned - -- to zero. - , ( -maxDenormal - , -minNormal - , -minNormal - ) - -- Round to nearest - -- - -- For a datatype with 4 bits of precision, the significands align as: - -- 1000 - -- 1001 - -- -------- + - -- 1001 - , ( 2 ^ (digits - 1) - , encodeFloat (2 ^ (digits - 1) + 1) (-digits) - , 2 ^ (digits - 1) + 1 - ) - -- 1000 - -- 01111 - -- --------- + - -- 1000 - , ( 2 ^ (digits - 1) - , encodeFloat (2 ^ digits - 1) (-digits - 1) - , 2 ^ (digits - 1) - ) - -- Ties to even - -- - -- 1000 - -- 1000 - -- -------- + - -- 1000 - , ( 2 ^ (digits - 1) - , encodeFloat (2 ^ (digits - 1)) (-digits) - , 2 ^ (digits - 1) - ) - -- Round to nearest - -- - -- For a datatype with 4 bits of precision, the significands align as: - -- 1001 - -- 1001 - -- -------- + - -- 1010 - , ( 2 ^ (digits - 1) + 1 - , encodeFloat (2 ^ (digits - 1) + 1) (-digits) - , 2 ^ (digits - 1) + 2 - ) - -- 1001 - -- 01111 - -- --------- + - -- 1001 - , ( 2 ^ (digits - 1) + 1 - , encodeFloat (2 ^ digits - 1) (-digits - 1) - , 2 ^ (digits - 1) + 1 - ) - -- Ties to even - -- - -- 1001 - -- 1000 - -- -------- + - -- 1010 - , ( 2 ^ (digits - 1) + 1 - , encodeFloat (2 ^ (digits - 1)) (-digits) - , 2 ^ (digits - 1) + 2 - ) - -- Rounding at maximum exponent - -- - -- 1111 - -- 1000 - -- -------- + - -- infinity - , ( maxFinite - , encodeFloat (2 ^ (digits - 1)) (maxExp - 2*digits) - , infinity - ) - -- 1111 - -- 01111 - -- --------- + - -- 1111 - , ( maxFinite - , encodeFloat (2 ^ digits - 1) (maxExp - 2*digits - 1) - , encodeFloat (2 ^ digits - 1) (maxExp - digits) - ) - -- Infinities - , (infinity, -maxFinite, infinity) - , (-infinity, maxFinite, -infinity) - , (infinity, -infinity, F.xilinxNaN) - ] - where - digits = floatDigits (undefined :: Float) - (_, maxExp) = floatRange (undefined :: Float) - -mulBasicSamples :: [(Float, Float, Float)] -mulBasicSamples = - delayOutput (natToNum @F.MulDefDelay) 0.0 $ - [ (1, 4, 4) - , (2, 5, 10) - , (3, 6, 18) - -- Subnormal positive number is conditioned to plus zero - -- - -- The unconditioned result is the subnormal of largest magnitude - , ( 1/2 - , encodeFloat (2 ^ digits - 2) (minExp - digits) - , 0 - ) - -- The unconditioned result is the subnormal of smallest magnitude - , ( encodeFloat 1 (1 - digits) - , minNormal - , 0 - ) - -- Subnormal negative number is conditioned to minus zero - -- - -- The unconditioned result is the subnormal of largest magnitude - , ( -1/2 - , encodeFloat (2 ^ digits - 2) (minExp - digits) - , -0 - ) - -- The unconditioned result is the subnormal of smallest magnitude - , ( encodeFloat 1 (1 - digits) - , -minNormal - , -0 - ) - -- Subnormals on input are conditioned to zero - -- - -- The result would normally be about four, but due to conditioning it is - -- zero. - , ( maxDenormal - , maxFinite - , 0 - ) - -- The result would normally be minNormal, but due to conditioning it is - -- zero. - , ( encodeFloat 1 (digits - 1) - , minDenormal - , 0 - ) - -- Subnormals on input are conditioned to zero, negative version - -- - -- - -- The result would normally be about -4, but due to conditioning it is - -- zero. - , ( -maxDenormal - , maxFinite - , -0 - ) - -- The result would normally be -minNormal, but due to conditioning it is - -- zero. - , ( encodeFloat 1 (digits - 1) - , -minDenormal - , -0 - ) - -- Round to nearest - -- - -- A small program has been used to determine the two numbers to be - -- multiplied such that they lead to the desired product. For ease of - -- comprehension, the result is shown in the comments in two formats. - -- - -- First, in an easily read format: as if it were the 8-bit result of a - -- product of two 4-bit mantissa's, to show the desired rounding (cf. - -- comments in addSubBasicSamples). - -- - -- If the structure of the full result is exactly equal to the ideal 8-bit - -- result, that is all. However, if the structure is not ideal, the 8-bit - -- result is shown with variable placeholders, and there, let XX = xx + 1. - -- - -- In addition, the precise result is shown for completenes in this case. - -- - -- 1xx0 1001 - -- -------- round - -- 1xx1 - -- - -- 0b1000_0000_0000_0000_0000_0110_1000_0000_0000_0000_0000_0001 - -- ------------------------------------------------------------- round - -- 0b1000_0000_0000_0000_0000_0111 - -- - , ( 14220287 - , 9896959 - , encodeFloat 0b1000_0000_0000_0000_0000_0111 digits - ) - -- - -- 1000 0111 - -- --------- round - -- 1000 - -- - , ( 10066329 - , 13981015 - , encodeFloat (2 ^ (digits - 1)) digits - ) - -- Ties to even - -- - -- 1000 1000 - -- --------- round - -- 1000 - , ( 12713984 - , 11069504 - , encodeFloat (2 ^ (digits - 1)) digits - ) - -- Round to nearest - -- - -- 1xx1 1001 - -- --------- round - -- 1XX0 - -- - -- 0b1000_0000_0000_0000_0000_1101_1000_0000_0000_0000_0000_0001 - -- ------------------------------------------------------------- round - -- 0b1000_0000_0000_0000_0000_1110 - -- - , ( 12427923 - , 11324315 - , encodeFloat 0b1000_0000_0000_0000_0000_1110 digits - ) - -- 1xx1 0111 - -- --------- round - -- 1xx1 - -- - -- 0b1000_0000_0000_0000_0000_1001_0111_1111_1111_1111_1111_1111 - -- ------------------------------------------------------------- round - -- 0b1000_0000_0000_0000_0000_1001 - -- - , ( 10837383 - , 12986313 - , encodeFloat 0b1000_0000_0000_0000_0000_1001 digits - ) - -- Ties to even - -- - -- 1001 1000 - -- --------- round - -- 1010 - , ( 12689408 - , 11090944 - , encodeFloat (2 ^ (digits - 1) + 2) digits - ) - -- Infinities - , (infinity, minNormal, infinity) - , (-infinity, minNormal, -infinity) - , (infinity, -minNormal, -infinity) - , (-infinity, -minNormal, infinity) - , (infinity, 0, F.xilinxNaN) - , (-infinity, 0, F.xilinxNaN) - , (infinity, -0, F.xilinxNaN) - , (-infinity, -0, F.xilinxNaN) - ] - ++ cartesianProductTest model interesting interesting - ++ nanTest - where - digits = floatDigits (undefined :: Float) - (minExp, _) = floatRange (undefined :: Float) - model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x * y - -divBasicSamples :: [(Float, Float, Float)] -divBasicSamples = - delayOutput (natToNum @F.DivDefDelay) 0.0 $ - [ (1, 2, 0.5) - , (3, 4, 0.75) - , (7, 8, 0.875) - -- Subnormal positive number is conditioned to plus zero - -- - -- The unconditioned result is the subnormal of largest magnitude - , ( encodeFloat (2 ^ digits - 2) (1 - digits) - , encodeFloat 1 (maxExp - 1) - , 0 - ) - -- The unconditioned result is the subnormal of smallest magnitude - , ( encodeFloat 2 (1 - digits) - , encodeFloat 1 (maxExp - 1) - , 0 - ) - -- Subnormal negative number is conditioned to minus zero - -- - -- The unconditioned result is the subnormal of largest magnitude - , ( -encodeFloat (2 ^ digits - 2) (1 - digits) - , encodeFloat 1 (maxExp - 1) - , -0 - ) - -- The unconditioned result is the subnormal of smallest magnitude - , ( -encodeFloat 2 (1 - digits) - , encodeFloat 1 (maxExp - 1) - , -0 - ) - -- Subnormals on input are conditioned to zero - -- - -- The result would normally be about one, but due to conditioning it is - -- zero. - , ( maxDenormal - , minNormal - , 0 - ) - -- The result would normally be about maxFinite/2, but due to - -- conditioning it is division by zero -> infinity. - , ( encodeFloat 2 (1 - digits) - , minDenormal - , infinity - ) - -- Subnormals on input are conditioned to zero, negative version - -- - -- - -- The result would normally be about -1, but due to conditioning it is - -- zero. - , ( -maxDenormal - , minNormal - , -0 - ) - -- The result would normally be about -maxFinite/2, but due to - -- conditioning it is division by zero -> negative infinity. - , ( encodeFloat 2 (1 - digits) - , -minDenormal - , -infinity - ) - -- Infinities - , (infinity, maxFinite, infinity) - , (-infinity, maxFinite, -infinity) - , (infinity, -maxFinite, -infinity) - , (-infinity, -maxFinite, infinity) - , (1, 0, infinity) - , (-1, 0, -infinity) - , (1, -0, -infinity) - , (-1, -0, infinity) - , (infinity, infinity, F.xilinxNaN) - , (-infinity, infinity, F.xilinxNaN) - , (infinity, -infinity, F.xilinxNaN) - , (-infinity, -infinity, F.xilinxNaN) - ] - ++ cartesianProductTest model interesting interesting - ++ nanTest - where - digits = floatDigits (undefined :: Float) - (_, maxExp) = floatRange (undefined :: Float) - model (conditionFloat -> x) (conditionFloat -> y) = conditionFloat $ x / y - -compareBasicSamples :: [(Float, Float, F.Ordering)] -compareBasicSamples = - delayOutput (natToNum @F.CompareDefDelay) F.NaN - $ [ (1.0, 2.0, F.LT) - , (2.0, 1.0, F.GT) - , (1.0, 1.0, F.EQ) - , (F.xilinxNaN, 1.0, F.NaN) - , (1.0, F.xilinxNaN, F.NaN) - ] ++ cartesianProductTest xilinxCompare interesting interesting - -cartesianProductTest - :: (a -> b -> c) - -> [a] - -> [b] - -> [(a,b,c)] -cartesianProductTest f as bs = - map (\(a,b) -> (a, b, f a b)) $ cartesianProduct as bs - -cartesianProduct - :: [a] - -> [b] - -> [(a,b)] -cartesianProduct as bs = - concatMap (\a -> map (\b -> (a,b)) bs) as - -interesting :: [Float] -interesting = - [ infinity - , minDenormal - , maxDenormal - , minNormal - , maxFinite - , epsilon - , F.xilinxNaN - -- Some basic numbers - , 0 - , 1 - , 2 - , 4 - , 42 - ] - -nanTest :: [(Float, Float, Float)] -nanTest = - concatMap testNaN - [ qNaN0PL - , negQNaN0PL - , qNaN1 - , negQNaN1 - , sNaN1 - , negSNaN1 - , qNaNMsb - , negQNaNMsb - , sNaNMsb - , negSNaNMsb - , qNaNMax - , negQNaNMax - , sNaNMax - , negSNaNMax - , qNaNR1 - , negQNaNR1 - , sNaNR1 - , negSNaNR1 - , qNaNR2 - , negQNaNR2 - , sNaNR2 - , negSNaNR2 - ] - where - testNaN :: Float -> [(Float, Float, Float)] - testNaN nan = - [ (nan, 1, F.xilinxNaN) - , (1, nan, F.xilinxNaN) - , (nan, nan, F.xilinxNaN) - ] - -fromUBasicSamples :: [(Unsigned 32, Float)] -fromUBasicSamples = delayOutput0 (natToNum @F.FromU32DefDelay) $ - map (\x -> (x, fromIntegral x)) - [ 0 - , 1 - , maxBound - - -- Patterns 0xaa and 0x55, but treating the "sign bit" separately. Floats - -- are stored in sign/magnitude form so signed and unsigned numbers are - -- not interchangeable like with two's complement. All these numbers - -- should be unsigned, verify that they are treated as such. - , 0b0010_1010_1010_1010_1010_1010_1010_1010 - , 0b0101_0101_0101_0101_0101_0101_0101_0101 - , 0b1010_1010_1010_1010_1010_1010_1010_1010 - , 0b1101_0101_0101_0101_0101_0101_0101_0101 - - , -- Longest exactly representable - 0b0000_0000_1111_1111_1111_1111_1111_1111 - - , -- Smallest with rounding - 0b0000_0001_0000_0000_0000_0000_0000_0001 - - -- More rounding tests - , 0b0000_0001_0000_0000_0000_0000_0000_0011 - , 0b0000_0010_0000_0000_0000_0000_0000_0001 - ] - where - delayOutput0 d es = zip is os - where - (is0, os0) = unzip es - is = is0 ++ repeat (last is0) - os = replicate d 0 ++ os0 - -fromSBasicSamples :: [(Signed 32, Float)] -fromSBasicSamples = delayOutput0 (natToNum @F.FromS32DefDelay) $ - map (\x -> (x, fromIntegral x)) (specials ++ map (* (-1)) specials) - - where - specials = - [ 0 - , 1 - , minBound - , maxBound - - -- Patterns 0xaa and 0x55, but treating the "sign bit" separately. Floats - -- are stored in sign/magnitude form so signed and unsigned numbers are - -- not interchangeable like with two's complement. - , 0b0010_1010_1010_1010_1010_1010_1010_1010 - , 0b0101_0101_0101_0101_0101_0101_0101_0101 - , 0b1010_1010_1010_1010_1010_1010_1010_1010 - , 0b1101_0101_0101_0101_0101_0101_0101_0101 - - , -- Longest exactly representable - 0b0000_0000_1111_1111_1111_1111_1111_1111 - - , -- Smallest with rounding - 0b0000_0001_0000_0000_0000_0000_0000_0001 - - -- More rounding tests - , 0b0000_0001_0000_0000_0000_0000_0000_0011 - , 0b0000_0010_0000_0000_0000_0000_0000_0001 - ] - - delayOutput0 d es = zip is os - where - (is0, os0) = unzip es - is = is0 ++ repeat (last is0) - os = replicate d 0 ++ os0 - --- Maximum subnormal value -maxDenormal :: Float -maxDenormal = minNormal - minDenormal - --- Quiet NaN with no payload --- Actually, this is equal to F.xilinxNaN -qNaN0PL :: Float -qNaN0PL = unpack 0b0111_1111_1100_0000_0000_0000_0000_0000 - --- Negative version -negQNaN0PL :: Float -negQNaN0PL = unpack 0b1111_1111_1100_0000_0000_0000_0000_0000 - --- Quiet NaN with payload 1 -qNaN1 :: Float -qNaN1 = unpack 0b0111_1111_1100_0000_0000_0000_0000_0001 - --- Negative version -negQNaN1 :: Float -negQNaN1 = unpack 0b1111_1111_1100_0000_0000_0000_0000_0001 - --- Signaling NaN with payload 1 -sNaN1 :: Float -sNaN1 = unpack 0b0111_1111_1000_0000_0000_0000_0000_0001 - --- Negative version -negSNaN1 :: Float -negSNaN1 = unpack 0b1111_1111_1000_0000_0000_0000_0000_0001 - --- Quiet NaN with payload with only MSB set -qNaNMsb :: Float -qNaNMsb = unpack 0b0111_1111_1110_0000_0000_0000_0000_0000 - --- Negative version -negQNaNMsb :: Float -negQNaNMsb = unpack 0b1111_1111_1110_0000_0000_0000_0000_0000 - --- Signaling NaN with payload with only MSB set -sNaNMsb :: Float -sNaNMsb = unpack 0b0111_1111_1010_0000_0000_0000_0000_0000 - --- Negative version -negSNaNMsb :: Float -negSNaNMsb = unpack 0b1111_1111_1010_0000_0000_0000_0000_0000 - --- Quiet NaN with maximum-valued payload -qNaNMax :: Float -qNaNMax = unpack 0b0111_1111_1111_1111_1111_1111_1111_1111 - --- Negative version -negQNaNMax :: Float -negQNaNMax = unpack 0b1111_1111_1111_1111_1111_1111_1111_1111 - --- Signaling NaN with maximum-valued payload -sNaNMax :: Float -sNaNMax = unpack 0b0111_1111_1011_1111_1111_1111_1111_1111 - --- Negative version -negSNaNMax :: Float -negSNaNMax = unpack 0b1111_1111_1011_1111_1111_1111_1111_1111 - --- Quiet NaN with random payload -qNaNR1 :: Float -qNaNR1 = unpack 0b0111_1111_1110_0000_1011_0001_0011_1100 - --- Negative version -negQNaNR1 :: Float -negQNaNR1 = unpack 0b1111_1111_1110_0000_1011_0001_0011_1100 - --- Signaling NaN with random payload -sNaNR1 :: Float -sNaNR1 = unpack 0b0111_1111_1010_0000_1011_0001_0011_1100 - --- Negative version -negSNaNR1 :: Float -negSNaNR1 = unpack 0b1111_1111_1010_0000_1011_0001_0011_1100 - --- Quiet NaN with random payload -qNaNR2 :: Float -qNaNR2 = unpack 0b0111_1111_1100_0010_0011_0000_1110_0101 - --- Negative version -negQNaNR2 :: Float -negQNaNR2 = unpack 0b1111_1111_1100_0010_0011_0000_1110_0101 - --- Signaling NaN with random payload -sNaNR2 :: Float -sNaNR2 = unpack 0b0111_1111_1000_0010_0011_0000_1110_0101 - --- Negative version -negSNaNR2 :: Float -negSNaNR2 = unpack 0b1111_1111_1000_0010_0011_0000_1110_0101 diff --git a/tests/shouldwork/Cores/Xilinx/Ila.hs b/tests/shouldwork/Cores/Xilinx/Ila.hs deleted file mode 100644 index ac22155461..0000000000 --- a/tests/shouldwork/Cores/Xilinx/Ila.hs +++ /dev/null @@ -1,216 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - -module Ila where - -import Clash.Explicit.Prelude - -import Data.List -import System.Directory -import System.Environment -import System.FilePath -import System.FilePath.Glob -import qualified Language.Haskell.TH as TH - -import Clash.Annotations.TH -import Clash.Cores.Xilinx.Ila -import Clash.Explicit.Testbench - -type Dom = XilinxSystem - -top :: "result" ::: Unsigned 8 -top = 0 --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE top #-} -makeTopEntity 'top - -oneCounter :: IlaConfig 1 -> Clock Dom -> Signal Dom () -oneCounter config clk = setName @"one_counter_ila" $ ila @Dom config clk counter - where - counter :: Signal Dom (Unsigned 64) - counter = register clk noReset enableGen 0 (counter + 1) - -threeCounters :: IlaConfig 3 -> Clock Dom -> Signal Dom () -threeCounters config clk = - setName @"three_counters_ila" $ - ila @Dom config clk counter0 counter1 counter2 - where - counter0 :: Signal Dom (Unsigned 64) - counter0 = register clk noReset enableGen 0 (counter0 + 1) - - counter1 :: Signal Dom (Unsigned 64) - counter1 = register clk noReset enableGen 0 (counter1 + 2) - - counter2 :: Signal Dom (Unsigned 64) - counter2 = register clk noReset enableGen 0 (counter2 + 3) - -testWithDefaultsOne :: Clock Dom -> Signal Dom () -testWithDefaultsOne = oneCounter (ilaConfig ("foo" :> Nil)) -{-# ANN testWithDefaultsOne (TestBench 'top) #-} -{-# ANN testWithDefaultsOne (defSyn "testWithDefaultsOne") #-} - -testWithDefaultsThree :: Clock Dom -> Signal Dom () -testWithDefaultsThree = threeCounters (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) -{-# ANN testWithDefaultsThree (TestBench 'top) #-} -{-# ANN testWithDefaultsThree (defSyn "testWithDefaultsThree") #-} - -testWithLefts :: Clock Dom -> Signal Dom () -testWithLefts = threeCounters $ - (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) - { comparators = Left 3 - , probeTypes = Left Data - , depth = D2048 - , captureControl = False - , stages = 5 - } -{-# ANN testWithLefts (TestBench 'top) #-} -{-# ANN testWithLefts (defSyn "testWithLefts") #-} - -testWithRights :: Clock Dom -> Signal Dom () -testWithRights = threeCounters $ - (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) - { comparators = Right (4 :> 5 :> 6 :> Nil) - , probeTypes = Right (DataAndTrigger :> Data :> Trigger :> Nil) - , depth = D1024 - , captureControl = True - , stages = 3 - } -{-# ANN testWithRights (TestBench 'top) #-} -{-# ANN testWithRights (defSyn "testWithRights") #-} - -testWithRightsSameCu :: Clock Dom -> Signal Dom () -testWithRightsSameCu = threeCounters $ - (ilaConfig ("foo" :> "bar" :> "ipsum" :> Nil)) - { comparators = Right (4 :> 4 :> 4 :> Nil) - , probeTypes = Right (Trigger :> Data :> DataAndTrigger :> Nil) - , depth = D4096 - , captureControl = True - , stages = 1 - , advancedTriggers = True - } -{-# ANN testWithRightsSameCu (TestBench 'top) #-} -{-# ANN testWithRightsSameCu (defSyn "testWithRightsSameCu") #-} - -mainVHDL :: IO () -mainVHDL = do - [dir] <- getArgs - - -- TCL content check: - main - - -- HDL content check: - let hdlDir = dir show 'testWithDefaultsOne - [path] <- glob (hdlDir "Ila_testWithDefaultsOne_ila.vhdl") - contents <- readFile path - assertIn contents "attribute KEEP of foo : signal is \"true\";" -- signal name - assertIn contents "one_counter_ila : testWithDefaultsOne_ila" -- instantiation label - -mainVerilog :: IO () -mainVerilog = main - -mainSystemVerilog :: IO () -mainSystemVerilog = main - -getTcl :: TH.Name -> IO String -getTcl nm = do - [dir] <- getArgs - let topDir = dir show nm - [tclFileName] <- filter (".tcl" `isSuffixOf`) <$> listDirectory topDir - let tclPath = topDir tclFileName - readFile tclPath - -assertIn :: String -> String -> IO () -assertIn haystack needle - | needle `isInfixOf` haystack = return () - | otherwise = error $ mconcat [ "Expected:\n\n ", needle - , "\n\nIn:\n\n", haystack ] - -main :: IO () -main = do - tcl <- getTcl 'testWithDefaultsOne - assertIn tcl "C_NUM_OF_PROBES 1" - assertIn tcl "C_INPUT_PIPE_STAGES 0" - assertIn tcl "C_DATA_DEPTH 4096" - assertIn tcl "ALL_PROBE_SAME_MU true" - assertIn tcl "C_EN_STRG_QUAL 1" - assertIn tcl "C_TRIGIN_EN false" - assertIn tcl "ALL_PROBE_SAME_MU_CNT 2" - assertIn tcl "C_PROBE0_WIDTH 64" - assertIn tcl "C_PROBE0_TYPE 0" - assertIn tcl "C_PROBE0_MU_CNT 2" - assertIn tcl "C_ADV_TRIGGER false" - - tcl <- getTcl 'testWithDefaultsThree - assertIn tcl "C_NUM_OF_PROBES 3" - assertIn tcl "C_INPUT_PIPE_STAGES 0" - assertIn tcl "C_DATA_DEPTH 4096" - assertIn tcl "ALL_PROBE_SAME_MU true" - assertIn tcl "C_EN_STRG_QUAL 1" - assertIn tcl "C_TRIGIN_EN false" - assertIn tcl "ALL_PROBE_SAME_MU_CNT 2" - assertIn tcl "C_PROBE0_WIDTH 64" - assertIn tcl "C_PROBE0_TYPE 0" - assertIn tcl "C_PROBE0_MU_CNT 2" - assertIn tcl "C_PROBE1_WIDTH 64" - assertIn tcl "C_PROBE1_TYPE 0" - assertIn tcl "C_PROBE1_MU_CNT 2" - assertIn tcl "C_PROBE2_WIDTH 64" - assertIn tcl "C_PROBE2_TYPE 0" - assertIn tcl "C_PROBE2_MU_CNT 2" - assertIn tcl "C_ADV_TRIGGER false" - - tcl <- getTcl 'testWithLefts - assertIn tcl "C_NUM_OF_PROBES 3" - assertIn tcl "C_INPUT_PIPE_STAGES 5" - assertIn tcl "C_DATA_DEPTH 2048" - assertIn tcl "ALL_PROBE_SAME_MU true" - assertIn tcl "C_EN_STRG_QUAL 0" - assertIn tcl "C_TRIGIN_EN false" - assertIn tcl "ALL_PROBE_SAME_MU_CNT 3" - assertIn tcl "C_PROBE0_WIDTH 64" - assertIn tcl "C_PROBE0_TYPE 1" - assertIn tcl "C_PROBE0_MU_CNT 3" - assertIn tcl "C_PROBE1_WIDTH 64" - assertIn tcl "C_PROBE1_TYPE 1" - assertIn tcl "C_PROBE1_MU_CNT 3" - assertIn tcl "C_PROBE2_WIDTH 64" - assertIn tcl "C_PROBE2_TYPE 1" - assertIn tcl "C_PROBE2_MU_CNT 3" - assertIn tcl "C_ADV_TRIGGER false" - - tcl <- getTcl 'testWithRights - assertIn tcl "C_NUM_OF_PROBES 3" - assertIn tcl "C_INPUT_PIPE_STAGES 3" - assertIn tcl "C_DATA_DEPTH 1024" - assertIn tcl "ALL_PROBE_SAME_MU false" - assertIn tcl "C_EN_STRG_QUAL 1" - assertIn tcl "C_TRIGIN_EN false" - assertIn tcl "C_PROBE0_WIDTH 64" - assertIn tcl "C_PROBE0_TYPE 0" - assertIn tcl "C_PROBE0_MU_CNT 4" - assertIn tcl "C_PROBE1_WIDTH 64" - assertIn tcl "C_PROBE1_TYPE 1" - assertIn tcl "C_PROBE1_MU_CNT 5" - assertIn tcl "C_PROBE2_WIDTH 64" - assertIn tcl "C_PROBE2_TYPE 2" - assertIn tcl "C_PROBE2_MU_CNT 6" - assertIn tcl "C_ADV_TRIGGER false" - - tcl <- getTcl 'testWithRightsSameCu - assertIn tcl "C_NUM_OF_PROBES 3" - assertIn tcl "C_INPUT_PIPE_STAGES 1" - assertIn tcl "C_DATA_DEPTH 4096" - assertIn tcl "ALL_PROBE_SAME_MU true" - assertIn tcl "C_EN_STRG_QUAL 1" - assertIn tcl "C_TRIGIN_EN false" - assertIn tcl "ALL_PROBE_SAME_MU_CNT 4" - assertIn tcl "C_PROBE0_WIDTH 64" - assertIn tcl "C_PROBE0_TYPE 2" - assertIn tcl "C_PROBE0_MU_CNT 4" - assertIn tcl "C_PROBE1_WIDTH 64" - assertIn tcl "C_PROBE1_TYPE 1" - assertIn tcl "C_PROBE1_MU_CNT 4" - assertIn tcl "C_PROBE2_WIDTH 64" - assertIn tcl "C_PROBE2_TYPE 0" - assertIn tcl "C_PROBE2_MU_CNT 4" - assertIn tcl "C_ADV_TRIGGER true" diff --git a/tests/shouldwork/Cores/Xilinx/T2549.hs b/tests/shouldwork/Cores/Xilinx/T2549.hs deleted file mode 100644 index 94dcfd5da3..0000000000 --- a/tests/shouldwork/Cores/Xilinx/T2549.hs +++ /dev/null @@ -1,17 +0,0 @@ -module T2549 where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO -import GHC.Magic - -topEntity :: Clock System -> Signal System Bit -topEntity c = hwSeqX probe v -- improper use of hwSeqX, the first argument of - -- hwSeqX should not have a function type. When - -- the first argument has a function type, it will - -- not be rendered. - where - probe :: Signal System Bit -> Signal System () - probe = vioProbe ("v1" :> "v2" :> Nil) Nil () c v - {-# INLINE probe #-} - - v = pure high diff --git a/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs b/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs deleted file mode 100644 index 405ada8dab..0000000000 --- a/tests/shouldwork/Cores/Xilinx/TdpBlockRam.hs +++ /dev/null @@ -1,209 +0,0 @@ -{-# OPTIONS_GHC -fconstraint-solver-iterations=10 #-} -{-# OPTIONS_GHC -Wno-orphans #-} - -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ViewPatterns #-} - -module TdpBlockRam where - -import Clash.Cores.Xilinx.BlockRam (tdpbram) -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench - -createDomain vXilinxSystem{vName="A", vPeriod=hzToPeriod 10e6 } -createDomain vXilinxSystem{vName="B", vPeriod=hzToPeriod 7e6 } - -topEntity :: - Clock A -> - Clock B -> - Signal A (Bool, Index 500, BitVector 2, Unsigned 16) -> - Signal B (Bool, Index 500, BitVector 2, Unsigned 16) -> - (Signal A (Unsigned 16), Signal B (Unsigned 16)) -topEntity - clkA clkB - (unbundle -> (enA, addrA, byteEnaA, datA)) - (unbundle -> (enB, addrB, byteEnaB, datB)) = - tdpbram - clkA (toEnable enA) addrA byteEnaA datA - clkB (toEnable enB) addrB byteEnaB datB --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE topEntity #-} - -tb :: - ( KnownNat n0, KnownNat n1, KnownNat n2, KnownNat n3 - , 1 <= n0, 1 <= n1, 1 <= n2, 1 <= n3 ) => - -- | Input on port A - Vec n0 (Bool, Index 500, BitVector 2, Unsigned 16)-> - -- | Expected data from port A - Vec n1 (Unsigned 16) -> - -- | Input on port B - Vec n2 (Bool, Index 500, BitVector 2, Unsigned 16) -> - -- | Expected data from port B - Vec n3 (Unsigned 16) -> - Signal A Bool -tb inputA expectedA inputB expectedB = - strictAnd <$> doneA <*> (unsafeSynchronizer clkB clkA doneB) - where - strictAnd !a !b = (&&) a b - - -- topEntity output - (actualA0, actualB0) = - topEntity - clkA clkB - (stimuliGenerator clkA noReset inputA) - (stimuliGenerator clkB noReset inputB) - - actualA1 = ignoreFor clkA noReset enableGen d1 0 actualA0 - actualB1 = ignoreFor clkB noReset enableGen d1 0 actualB0 - - -- Verification - outputVerifierA = outputVerifierWith - (\clk rst -> assert clk rst "outputVerifier Port A") - outputVerifierB = outputVerifierWith - (\clk rst -> assert clk rst "outputVerifier Port B") - - doneA = outputVerifierA clkA clkA noReset expectedA actualA1 - doneB = outputVerifierB clkB clkB noReset expectedB actualB1 - - -- Testbench clocks - clkA :: Clock A - clkA = tbClockGen (not <$> doneA) - clkB :: Clock B - clkB = tbClockGen (not <$> doneB) - --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE normalWritesTB #-} -{-# ANN normalWritesTB (TestBench 'topEntity) #-} --- | Test bench doing some (non-overlapping) writes and reads on two ports, either --- with the byte enable fully set, or fully unset. -normalWritesTB :: Signal A Bool -normalWritesTB = tb inputA expectedA inputB expectedB - where - -- Note that the initial value coming from the blockram is undefined, but we - -- mask it using 'ignoreFor'. - initVal = 0 - - expectedA = - (initVal :> 55 :> 66 :> 55 :> 66 :> Nil) ++ - (repeat @10 66) ++ - (77 :> 88 :> Nil) - expectedB = - (initVal :> 77 :> 88 :> 77 :> 88 :> Nil) ++ - (repeat @10 88) ++ - (55 :> 66 :> Nil) - - doWrite = maxBound - noWrite = 0 - noOp = (False, 0, 0, 0) - - inputA = - ( (True, 0, doWrite, 55) - :> (True, 1, doWrite, 66) - :> (True, 0, noWrite, 0) - :> (True, 1, noWrite, 0) - :> Nil - ) ++ repeat @10 noOp ++ - ( - (True, 2, noWrite, 0) - :> (True, 3, noWrite, 0) - :> Nil - ) - ++ repeat @10 noOp - - inputB = - ( (True, 2, doWrite, 77) - :> (True, 3, doWrite, 88) - :> (True, 2, noWrite, 0) - :> (True, 3, noWrite, 0) - :> Nil - ) ++ repeat @10 noOp ++ - ( - (True, 0, noWrite, 0) - :> (True, 1, noWrite, 0) - :> Nil - ) ++ repeat @10 noOp - --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE writeEnableWritesTB #-} -{-# ANN writeEnableWritesTB (TestBench 'topEntity) #-} --- | Test bench doing some (non-overlapping) writes and reads on two ports, with --- varying byte enables. -writeEnableWritesTB :: Signal A Bool -writeEnableWritesTB = tb inputA expectedA inputB expectedB - where - -- Note that the initial value coming from the blockram is undefined, but we - -- mask it using 'ignoreFor'. - initVal = 0 - - expectedA = - initVal - :> 0 - :> 0 - :> 0 - :> 0 - - :> 0 - :> 0x00AA - :> 0xAA00 - :> 0xAAAA - - :> 0 - :> 0x00AA - :> 0xAA00 - :> 0xAAAA - :> Nil - - expectedB = - initVal - :> 0 - :> 0 - :> 0 - :> 0 - - :> 0 - :> 0x00AA - :> 0xAA00 - :> 0xAAAA - - :> 0 - :> 0x00AA - :> 0xAA00 - :> 0xAAAA - :> Nil - - noWrite = 0 - - inputA = - ( (True, 0, 0b11, 0 ) - :> (True, 1, 0b11, 0 ) - :> (True, 2, 0b11, 0 ) - :> (True, 3, 0b11, 0 ) - - :> (True, 0, 0b00, 0xAAAA) - :> (True, 1, 0b01, 0xAAAA) - :> (True, 2, 0b10, 0xAAAA) - :> (True, 3, 0b11, 0xAAAA) - - :> (True, 0, noWrite, 0 ) - :> (True, 1, noWrite, 0 ) - :> (True, 2, noWrite, 0 ) - :> (True, 3, noWrite, 0 ) - :> Nil - ) - - inputB = - ( (True, 4, 0b11, 0 ) - :> (True, 5, 0b11, 0 ) - :> (True, 6, 0b11, 0 ) - :> (True, 7, 0b11, 0 ) - :> (True, 4, 0b00, 0xAAAA) - :> (True, 5, 0b01, 0xAAAA) - :> (True, 6, 0b10, 0xAAAA) - :> (True, 7, 0b11, 0xAAAA) - :> (True, 4, noWrite, 0 ) - :> (True, 5, noWrite, 0 ) - :> (True, 6, noWrite, 0 ) - :> (True, 7, noWrite, 0 ) - :> Nil - ) diff --git a/tests/shouldwork/Cores/Xilinx/VIO.hs b/tests/shouldwork/Cores/Xilinx/VIO.hs deleted file mode 100644 index 483ebc32ed..0000000000 --- a/tests/shouldwork/Cores/Xilinx/VIO.hs +++ /dev/null @@ -1,398 +0,0 @@ -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} - -module VIO where - -import Clash.Prelude -import Clash.Cores.Xilinx.VIO -import Clash.Annotations.TH -import Clash.Annotations.BitRepresentation -import Clash.Explicit.Testbench - -import Control.Monad (unless) -import Control.Monad.Extra (anyM) -import GHC.Stack (HasCallStack) -import System.Environment (getArgs) -import System.FilePath (()) -import System.FilePath.Glob (globDir1) - -import qualified Language.Haskell.TH as TH -import qualified Data.List as L - -type Dom = XilinxSystem - -top :: "result" ::: Unsigned 8 -top = 0 --- See: https://github.com/clash-lang/clash-compiler/pull/2511 -{-# CLASH_OPAQUE top #-} - -makeTopEntity 'top - -noInputTrue :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom Bool -noInputTrue = vioProbe @Dom inNames outNames True - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputTrue (TestBench 'top) #-} - -makeTopEntity 'noInputTrue - - -noInputFalse :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom Bool -noInputFalse = vioProbe @Dom inNames outNames False - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputFalse (TestBench 'top) #-} - -makeTopEntity 'noInputFalse - - -noInputLow :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom Bit -noInputLow = vioProbe @Dom inNames outNames low - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputLow (TestBench 'top) #-} - -makeTopEntity 'noInputLow - - -noInputHigh :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom Bit -noInputHigh = vioProbe @Dom inNames outNames high - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputHigh (TestBench 'top) #-} - -makeTopEntity 'noInputHigh - - -noInputSigned :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom (Signed 2) -noInputSigned = vioProbe @Dom inNames outNames (-1) - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputSigned (TestBench 'top) #-} - -makeTopEntity 'noInputSigned - - -noInputUnsigned :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom (Unsigned 2) -noInputUnsigned = vioProbe @Dom inNames outNames 3 - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputUnsigned (TestBench 'top) #-} - -makeTopEntity 'noInputUnsigned - - -noInputBitVector :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom (BitVector 7) -noInputBitVector = vioProbe @Dom inNames outNames 111 - where - inNames = Nil - outNames = singleton "probe_out" -{-# ANN noInputBitVector (TestBench 'top) #-} - -makeTopEntity 'noInputBitVector - - -noInputPair :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom (Bit, Bool) -noInputPair = vioProbe @Dom inNames outNames (high, False) - where - inNames = Nil - outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0,1])) -{-# ANN noInputPair (TestBench 'top) #-} - -makeTopEntity 'noInputPair - - -noInputVec :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom (Vec 4 (Unsigned 2)) -noInputVec = vioProbe @Dom inNames outNames (0 :> 1 :> 2 :> 3 :> Nil) - where - inNames = Nil - outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..3])) -{-# ANN noInputVec (TestBench 'top) #-} - -makeTopEntity 'noInputVec - - -data D1 = D1 Bool Bit (Unsigned 2) - -noInputCustom :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom D1 -noInputCustom = vioProbe @Dom inNames outNames (D1 True high 1) - where - inNames = Nil - outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..2])) -{-# ANN noInputCustom (TestBench 'top) #-} - -makeTopEntity 'noInputCustom - - -data D2 = D2 Bool (Vec 2 D1) - -noInputNested :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom D2 -noInputNested = vioProbe @Dom inNames outNames (D2 True (D1 True high 1 :> D1 False low 0 :> Nil)) - where - inNames = Nil - outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..1])) -{-# ANN noInputNested (TestBench 'top) #-} - -makeTopEntity 'noInputNested - - -data T = R Bool Bool -{-# ANN module (DataReprAnn - $(liftQ [t|T|]) - 3 - [ ConstrRepr 'R 0b111 0b000 [0b010, 0b001] - ]) #-} -{- TODO: Custom bit representations are not supported within VIOs - yet. See Clash.Cores.Xilinx.VIO.Internal.BlackBoxes for details. -noInputCustomRep :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom T -noInputCustomRep = vioProbe @Dom (R True False) - -makeTopEntityWithName 'noInputCustomRep "" --} - - -singleInputBool :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom Bool -> - "result" ::: Signal Dom () -singleInputBool = vioProbe @Dom inNames outNames () - where - inNames = singleton "probe_in" - outNames = Nil -{-# ANN singleInputBool (TestBench 'top) #-} - -makeTopEntity 'singleInputBool - - -singleInputBit :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom Bit -> - "result" ::: Signal Dom () -singleInputBit = vioProbe @Dom inNames outNames () - where - inNames = singleton "probe_in" - outNames = Nil -{-# ANN singleInputBit (TestBench 'top) #-} - -makeTopEntity 'singleInputBit - - -singleInputSigned :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom (Signed 2) -> - "result" ::: Signal Dom () -singleInputSigned = vioProbe @Dom inNames outNames () - where - inNames = singleton "probe_in" - outNames = Nil -{-# ANN singleInputSigned (TestBench 'top) #-} - -makeTopEntity 'singleInputSigned - - -singleInputUnsigned :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom (Unsigned 2) -> - "result" ::: Signal Dom () -singleInputUnsigned = vioProbe @Dom inNames outNames () - where - inNames = singleton "probe_in" - outNames = Nil -{-# ANN singleInputUnsigned (TestBench 'top) #-} - -makeTopEntity 'singleInputUnsigned - - -singleInputBitVector :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom (BitVector 7) -> - "result" ::: Signal Dom () -singleInputBitVector = vioProbe @Dom inNames outNames () - where - inNames = singleton "probe_in" - outNames = Nil -{-# ANN singleInputBitVector (TestBench 'top) #-} - -makeTopEntity 'singleInputBitVector - - -singleInputPair :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom (Bit, Bool) -> - "result" ::: Signal Dom () -singleInputPair = vioProbe @Dom inNames outNames () - where - inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..1])) - outNames = Nil -{-# ANN singleInputPair (TestBench 'top) #-} - -makeTopEntity 'singleInputPair - - -singleInputVec :: - "clk" ::: Clock Dom -> - "result" ::: Signal Dom (Vec 4 (Unsigned 2)) -> - "result" ::: Signal Dom () -singleInputVec = vioProbe @Dom inNames outNames () - where - inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..3])) - outNames = Nil -{-# ANN singleInputVec (TestBench 'top) #-} - -makeTopEntity 'singleInputVec - - -singleInputCustom :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom D1 -> - "result" ::: Signal Dom () -singleInputCustom = vioProbe @Dom inNames outNames () - where - inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..2])) - outNames = Nil -{-# ANN singleInputCustom (TestBench 'top) #-} - -makeTopEntity 'singleInputCustom - - -singleInputNested :: - "clk" ::: Clock Dom -> - "inp" ::: Signal Dom D2 -> - "result" ::: Signal Dom () -singleInputNested = vioProbe @Dom inNames outNames () - where - inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..1])) - outNames = Nil -{-# ANN singleInputNested (TestBench 'top) #-} - -makeTopEntity 'singleInputNested - - -multipleInputs :: - "clk" ::: Clock Dom -> - "in1" ::: Signal Dom Bit -> - "in2" ::: Signal Dom Bool -> - "in3" ::: Signal Dom (Unsigned 3) -> - "in4" ::: Signal Dom (Signed 4) -> - "in5" ::: Signal Dom (Bit, Bool, Bit) -> - "in6" ::: Signal Dom (Vec 3 (Unsigned 2)) -> - "in7" ::: Signal Dom D1 -> - "in8" ::: Signal Dom (BitVector 7) -> - "result" ::: Signal Dom (Vec 0 Bool) -multipleInputs = vioProbe @Dom inNames outNames Nil - where - inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..7])) - outNames = Nil -{-# ANN multipleInputs (TestBench 'top) #-} - -makeTopEntity 'multipleInputs - - -inputsAndOutputs :: - "clk" ::: Clock Dom -> - "in1" ::: Signal Dom Bit -> - "in2" ::: Signal Dom Bool -> - "in3" ::: Signal Dom ( Unsigned 3 ) -> - "in4" ::: Signal Dom ( Signed 4 ) -> - "in5" ::: Signal Dom ( Bit, Bool, Bit ) -> - "in6" ::: Signal Dom ( Vec 3 (Unsigned 2) ) -> - "in7" ::: Signal Dom D1 -> - "in8" ::: Signal Dom ( BitVector 7 ) -> - "result" ::: Signal Dom ( Bit - , Bool - , Unsigned 5 - , Signed 2 - , (Bool, Bit, Bool) - , Vec 2 (Unsigned 3) - , D1 - , BitVector 6 - ) -inputsAndOutputs = vioProbe @Dom inNames outNames initVals - where - inNames = $(listToVecTH (L.map (("probe_in_" <>) . show) [0..7])) - outNames = $(listToVecTH (L.map (("probe_out_" <>) . show) [0..7])) - initVals = - ( low - , True - , 1 - , -1 - , (True, low, False) - , 5 :> 3 :> Nil - , D1 False high 0 - , 0b111000 - ) -{-# ANN inputsAndOutputs (TestBench 'top) #-} - -makeTopEntity 'inputsAndOutputs - -withSetName :: - "clk" ::: Clock Dom -> - "arg" ::: Signal Dom Bit -> - "result" ::: Signal Dom Bit -withSetName = - setName @"my_vio" $ - vioProbe @Dom ("a" :> Nil) ("b" :> Nil) low -{-# ANN withSetName (TestBench 'top) #-} - -makeTopEntity 'withSetName - -withSetNameNoResult :: - "clk" ::: Clock Dom -> - "arg" ::: Signal Dom Bit -> - "result" ::: Signal Dom () -withSetNameNoResult = - setName @"my_vio" $ - vioProbe @Dom ("a" :> Nil) (Nil) () -{-# ANN withSetNameNoResult (TestBench 'top) #-} - -makeTopEntity 'withSetNameNoResult - -mainVHDL :: IO () -mainVHDL = do - [topDir] <- getArgs - - test topDir 'withSetName - test topDir 'withSetNameNoResult - - where - test :: HasCallStack => FilePath -> TH.Name -> IO () - test topDir nm = do - let hdlDir = topDir show nm - paths <- L.sort <$> globDir1 "*.vhdl" hdlDir - result <- anyM containsMyVio paths - unless result $ error $ "'my_vio' not found in any of: " <> show paths - - containsMyVio :: FilePath -> IO Bool - containsMyVio path = do - contents <- readFile path - pure $ "my_vio" `L.isInfixOf` contents diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingle.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingle.hs deleted file mode 100644 index 691abc4285..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingle.hs +++ /dev/null @@ -1,69 +0,0 @@ -module XpmCdcArraySingle where - -import Clash.Explicit.Prelude -import Data.Proxy - -import XpmTestCommon (D3, D5, D10, D11) - -import qualified XpmCdcArraySingleTypes as Types - --- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot --- find the test benches. -topEntity :: Unsigned 1 -topEntity = 0 - -tb0 = done - where - -- src dst stages width samples init reg - done = Types.tb @D3 @D5 @4 @1 @100 Proxy Proxy False False SNat expected - expected = $(Types.expected @D3 @D5 @4 @1 @100 Proxy Proxy False False SNat SNat SNat) -{-# ANN tb0 (TestBench 'topEntity) #-} - -tb1 = done - where - -- src dst stages width samples init reg - done = Types.tb @D5 @D3 @4 @2 @100 Proxy Proxy False True SNat expected - expected = $(Types.expected @D5 @D3 @4 @2 @100 Proxy Proxy False True SNat SNat SNat) -{-# ANN tb1 (TestBench 'topEntity) #-} - -tb2 = done - where - -- src dst stages width samples init reg - done = Types.tb @D3 @D5 @10 @16 @100 Proxy Proxy True False SNat expected - expected = $(Types.expected @D3 @D5 @10 @16 @100 Proxy Proxy True False SNat SNat SNat) -{-# ANN tb2 (TestBench 'topEntity) #-} - -tb3 = done - where - -- src dst stages width samples init reg - done = Types.tb @D3 @D5 @2 @64 @100 Proxy Proxy True True SNat expected - expected = $(Types.expected @D3 @D5 @2 @64 @100 Proxy Proxy True True SNat SNat SNat) -{-# ANN tb3 (TestBench 'topEntity) #-} - -tb4 = done - where - -- src dst stages width samples init reg - done = Types.tb @D5 @D10 @2 @7 @100 Proxy Proxy False False SNat expected - expected = $(Types.expected @D5 @D10 @2 @7 @100 Proxy Proxy False False SNat SNat SNat) -{-# ANN tb4 (TestBench 'topEntity) #-} - -tb5 = done - where - -- src dst stages width samples init reg - done = Types.tb @D10 @D5 @2 @16 @100 Proxy Proxy False True SNat expected - expected = $(Types.expected @D10 @D5 @2 @16 @100 Proxy Proxy False True SNat SNat SNat) -{-# ANN tb5 (TestBench 'topEntity) #-} - -tb6 = done - where - -- src dst stages width samples init reg - done = Types.tb @D5 @D11 @2 @16 @100 Proxy Proxy True False SNat expected - expected = $(Types.expected @D5 @D11 @2 @16 @100 Proxy Proxy True False SNat SNat SNat) -{-# ANN tb6 (TestBench 'topEntity) #-} - -tb7 = done - where - -- src dst stages width samples init reg - done = Types.tb @D11 @D5 @2 @16 @100 Proxy Proxy True True SNat expected - expected = $(Types.expected @D11 @D5 @2 @16 @100 Proxy Proxy True True SNat SNat SNat) -{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs deleted file mode 100644 index dd97578042..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcArraySingleTypes.hs +++ /dev/null @@ -1,82 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module XpmCdcArraySingleTypes where - -import Clash.Cores.Xilinx.Xpm.Cdc.ArraySingle -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench -import Data.Proxy -import Language.Haskell.TH.Lib -import XpmTestCommon - -testData :: (KnownNat width, KnownDomain dom, width <= 64) => Clock dom -> Signal dom (Unsigned width) -testData = genTestData randomSeed - -tb :: - forall a b stages width n . - ( KnownNat n, 1 <= n - , KnownNat stages, 2 <= stages, stages <= 10 - , KnownNat width, 1 <= width, width <= 64 - , KnownDomain a - , KnownDomain b - ) => - Proxy a -> Proxy b -> - -- | Initial values - Bool -> - -- | Registered input - Bool -> - SNat stages -> - -- | Expected data - Vec n (BitVector width) -> - Signal b Bool -tb Proxy Proxy initVals regInput SNat expectedDat = done - where - actual = - xpmCdcArraySingleWith - @stages @(Unsigned width) - (XpmCdcArraySingleConfig SNat initVals regInput) - clkA - clkB - (testData clkA) - - done = - outputVerifierWith - (\clk rst -> assertBitVector clk rst "outputVerifier A") - clkB clkB noReset - expectedDat - (pack <$> actual) - - -- Testbench clocks - clkA :: Clock a - clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) - clkB :: Clock b - clkB = tbClockGen (not <$> done) - -expected :: - forall a b stages width samples . - ( KnownDomain a - , KnownDomain b - , 2 <= stages, stages <= 10 - , 1 <= width, width <= 64 - ) => - Proxy a -> - Proxy b -> - -- | Initial values - Bool -> - -- | Registered input - Bool -> - SNat stages -> - SNat width -> - SNat samples -> - ExpQ -expected Proxy Proxy initVals regInput SNat SNat SNat = listToVecTH out1 - where - out0 = - xpmCdcArraySingleWith - @stages @(Unsigned width) - (XpmCdcArraySingleConfig SNat initVals regInput) - (clockGen @a) - (clockGen @b) - (testData clockGen) - - out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcGray.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcGray.hs deleted file mode 100644 index 9d9ad26689..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcGray.hs +++ /dev/null @@ -1,69 +0,0 @@ -module XpmCdcGray where - -import Clash.Explicit.Prelude -import Data.Proxy - -import XpmTestCommon (D3, D5, D10, D11) - -import qualified XpmCdcGrayTypes as Types - --- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot --- find the test benches. -topEntity :: Unsigned 1 -topEntity = 0 - -tb0 = done - where - -- src dst width stages samples - done = Types.tb @D3 @D5 @4 @4 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D3 @D5 @4 @4 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb0 (TestBench 'topEntity) #-} - -tb1 = done - where - -- src dst width stages samples - done = Types.tb @D5 @D3 @16 @4 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D5 @D3 @16 @4 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb1 (TestBench 'topEntity) #-} - -tb2 = done - where - -- src dst width stages samples - done = Types.tb @D3 @D5 @16 @10 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D3 @D5 @16 @10 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb2 (TestBench 'topEntity) #-} - -tb3 = done - where - -- src dst width stages samples - done = Types.tb @D3 @D5 @16 @2 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D3 @D5 @16 @2 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb3 (TestBench 'topEntity) #-} - -tb4 = done - where - -- src dst width stages samples - done = Types.tb @D5 @D10 @16 @2 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D5 @D10 @16 @2 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb4 (TestBench 'topEntity) #-} - -tb5 = done - where - -- src dst width stages samples - done = Types.tb @D10 @D5 @16 @2 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D10 @D5 @16 @2 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb5 (TestBench 'topEntity) #-} - -tb6 = done - where - -- src dst width stages samples - done = Types.tb @D5 @D11 @16 @2 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D5 @D11 @16 @2 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb6 (TestBench 'topEntity) #-} - -tb7 = done - where - -- src dst width stages samples - done = Types.tb @D11 @D5 @16 @2 @100 Proxy Proxy SNat expected - expected = $(Types.expected @D11 @D5 @16 @2 @100 Proxy Proxy SNat SNat SNat) -{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs deleted file mode 100644 index d98eb9f3cb..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcGrayTypes.hs +++ /dev/null @@ -1,65 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module XpmCdcGrayTypes where - -import Clash.Cores.Xilinx.Xpm.Cdc.Gray -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench -import Data.Proxy -import Language.Haskell.TH.Lib - -tb :: - forall a b width stages n . - ( KnownNat n, 1 <= n - , KnownNat stages, 2 <= stages, stages <= 10 - , KnownNat width, 2 <= width, width <= 32 - , KnownDomain a - , KnownDomain b - ) => - Proxy a -> Proxy b -> SNat stages -> - -- | Expected data - Vec n (BitVector width) -> - Signal b Bool -tb Proxy Proxy SNat expectedDat = done - where - counter = delay clkA enableGen 0 (counter + 1) - - actual = xpmCdcGrayWith @stages @width (XpmCdcGrayConfig SNat True) clkA clkB counter - - done = - outputVerifierWith - (\clk rst -> assertBitVector clk rst "outputVerifier Port A") - clkB clkB noReset - expectedDat - (pack <$> actual) - - -- Testbench clocks - clkA :: Clock a - clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) - clkB :: Clock b - clkB = tbClockGen (not <$> done) - -expected :: - forall a b n stages samples . - ( KnownDomain a - , KnownDomain b - , 2 <= stages, stages <= 10 - , 2 <= n, n <= 32 - ) => - Proxy a -> - Proxy b -> - SNat n -> - SNat stages -> - SNat samples -> - ExpQ -expected Proxy Proxy SNat SNat SNat = listToVecTH out1 - where - out0 = - xpmCdcGrayWith - @stages @n - (XpmCdcGrayConfig SNat True) - (clockGen @a) - (clockGen @b) - (fromList (cycle [0..])) - - out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshake.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcHandshake.hs deleted file mode 100644 index 4345455315..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshake.hs +++ /dev/null @@ -1,82 +0,0 @@ -module XpmCdcHandshake where - -import Clash.Cores.Xilinx.Xpm.Cdc.Handshake -import Clash.Explicit.Prelude -import Data.Proxy - -import XpmTestCommon (D3, D5, D10, D11) - -import qualified XpmCdcHandshakeTypes as Types - --- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot --- find the test benches. -topEntity :: Unsigned 1 -topEntity = 0 -{-# NOINLINE topEntity #-} - -tb0 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D3 @D5 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D3 @D5 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb0 (TestBench 'topEntity) #-} -{-# NOINLINE tb0 #-} - -tb1 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb1 (TestBench 'topEntity) #-} -{-# NOINLINE tb1 #-} - -tb2 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D5 @D3 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb2 (TestBench 'topEntity) #-} -{-# NOINLINE tb2 #-} - -tb3 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D5 @D10 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D5 @D10 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb3 (TestBench 'topEntity) #-} -{-# NOINLINE tb3 #-} - -tb4 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb4 (TestBench 'topEntity) #-} -{-# NOINLINE tb4 #-} - -tb5 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D3 @D11 @3 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D3 @D11 @3 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb5 (TestBench 'topEntity) #-} -{-# NOINLINE tb5 #-} - -tb6 = done - where - -- src dst srcStages dstStages samples init - done = Types.tb @D3 @D11 @2 @3 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) expected - expected = $(Types.expected @D3 @D11 @2 @3 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat True) SNat) -{-# ANN tb6 (TestBench 'topEntity) #-} -{-# NOINLINE tb6 #-} - --- XXX: Test code does not handle undefined values. Given that this primitive --- is defined purely in terms of translatable/synthesizable constructs --- though, I don't think it is too bad to skip this test though. --- tb7 = done --- where --- -- src dst srcStages dstStages samples init --- done = Types.tb @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat False) expected --- expected = $(Types.expected @D3 @D11 @2 @2 @100 Proxy Proxy (XpmCdcHandshakeConfig SNat SNat False) SNat) --- {-# ANN tb7 (TestBench 'topEntity) #-} --- {-# NOINLINE tb7 #-} diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs deleted file mode 100644 index 3fb479f72c..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcHandshakeTypes.hs +++ /dev/null @@ -1,117 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# OPTIONS_GHC -Wno-orphans #-} - - -module XpmCdcHandshakeTypes where - -import Clash.Cores.Xilinx.Xpm.Cdc.Handshake -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench -import Data.Proxy -import Language.Haskell.TH.Lib - -data State = WaitForDeassert | WaitForAssert (Index 2) deriving (Generic, NFDataX) - --- | Transfer 1, 2, 3, ... to destination domain -srcFsm :: - forall a src . - ( KnownDomain src - , Num a - , NFDataX a - ) => - Clock src -> - Signal src Bool -> - Signal src (a, Bool) -srcFsm clk = mealy clk noReset enableGen go (0, WaitForDeassert) - where - go (n, WaitForDeassert) True = ((n, WaitForDeassert), (0, False)) - go (n, WaitForDeassert) False = ((n + 1, WaitForAssert maxBound), (n + 1, True)) - go (n, WaitForAssert _) False = ((n, WaitForAssert maxBound), (n, True)) - go (n, WaitForAssert 0) True = ((n, WaitForDeassert), (0, False)) - go (n, WaitForAssert w) True = ((n, WaitForAssert (w-1)), (n, True)) -- seen src_rcv, wait a little before dropping src_send -{-# NOINLINE srcFsm #-} - --- | Receives data from source domain -dstFsm :: - forall a dst . - KnownDomain dst => - Clock dst -> - Signal dst (Bool, a) -> - Signal dst (Bool, Maybe a) -dstFsm clk = mealy clk noReset enableGen go (WaitForAssert maxBound) - where - go (WaitForAssert _) (False, _) = (WaitForAssert maxBound, (False, Nothing)) - go (WaitForAssert 0) (True, n) = (WaitForDeassert, (True, Just n)) - go (WaitForAssert w) (True, n) = (WaitForAssert (w-1), (False, Nothing)) -- seen dest_req, wait a little before asserting dest_ack - go WaitForDeassert (True, _) = (WaitForDeassert, (True, Nothing)) - go WaitForDeassert (False, _) = (WaitForAssert maxBound, (False, Nothing)) -{-# NOINLINE dstFsm #-} - --- | Composition of 'srcFsm' and 'dstFsm' -top :: - forall a srcStages dstStages src dst . - ( KnownDomain src - , KnownDomain dst - , Num a - , NFDataX a - , BitPack a - , 1 <= BitSize a, BitSize a <= 1024 - , 2 <= srcStages, srcStages <= 10 - , 2 <= dstStages, dstStages <= 10 - ) => - XpmCdcHandshakeConfig srcStages dstStages -> - Clock src -> - Clock dst -> - Signal dst (Maybe a) -top opts clkSrc clkDst = maybeDat - where - (srcIn, srcSend) = unbundle $ srcFsm @a clkSrc srcRcv - - (destOut, destReq, srcRcv) = - xpmCdcHandshakeWith opts clkSrc clkDst srcIn srcSend destAck - - (destAck, maybeDat) = - unbundle $ dstFsm @a clkDst $ bundle (destReq, destOut) -{-# NOINLINE top #-} - -tb :: - forall a b srcStages dstStages n . - ( KnownNat n, 1 <= n - , 2 <= srcStages, srcStages <= 10 - , 2 <= dstStages, dstStages <= 10 - , KnownDomain a - , KnownDomain b - ) => - Proxy a -> Proxy b -> - XpmCdcHandshakeConfig srcStages dstStages -> - -- | Expected data - Vec n (Maybe (Unsigned 8)) -> - Signal b Bool -tb Proxy Proxy opts expectedDat = done - where - actual = top @(Unsigned 8) opts clkA clkB - - done = outputVerifier' clkB noReset expectedDat actual - - -- Testbench clocks - clkA :: Clock a - clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) - clkB :: Clock b - clkB = tbClockGen (not <$> done) - -expected :: - forall a b srcStages dstStages samples . - ( KnownDomain a - , KnownDomain b - , 2 <= srcStages, srcStages <= 10 - , 2 <= dstStages, dstStages <= 10 - ) => - Proxy a -> - Proxy b -> - XpmCdcHandshakeConfig srcStages dstStages -> - SNat samples -> - ExpQ -expected Proxy Proxy opts SNat = listToVecTH out1 - where - out0 = top @(Unsigned 8) opts (clockGen @a) (clockGen @b) - out1 = sampleN (natToNum @samples) out0 diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcPulse.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcPulse.hs deleted file mode 100644 index 1174ba0da4..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcPulse.hs +++ /dev/null @@ -1,70 +0,0 @@ -module XpmCdcPulse where - -import Clash.Explicit.Prelude - -import Data.Proxy - -import XpmTestCommon (D3, D5, D10, D11) - -import qualified XpmCdcPulseTypes as Types - --- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot --- find the test benches. -topEntity :: Unsigned 1 -topEntity = 0 - -tb0 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D3 @D5 @4 @100 Proxy Proxy False False True SNat expected - expected = $(Types.expected @D3 @D5 @4 @100 Proxy Proxy False False True SNat SNat) -{-# ANN tb0 (TestBench 'topEntity) #-} - -tb1 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D5 @D3 @4 @100 Proxy Proxy False True True SNat expected - expected = $(Types.expected @D5 @D3 @4 @100 Proxy Proxy False True True SNat SNat) -{-# ANN tb1 (TestBench 'topEntity) #-} - -tb2 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D3 @D5 @10 @100 Proxy Proxy True False False SNat expected - expected = $(Types.expected @D3 @D5 @10 @100 Proxy Proxy True False False SNat SNat) -{-# ANN tb2 (TestBench 'topEntity) #-} - -tb3 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D3 @D5 @2 @100 Proxy Proxy True True True SNat expected - expected = $(Types.expected @D3 @D5 @2 @100 Proxy Proxy True True True SNat SNat) -{-# ANN tb3 (TestBench 'topEntity) #-} - -tb4 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D5 @D10 @2 @100 Proxy Proxy False False True SNat expected - expected = $(Types.expected @D5 @D10 @2 @100 Proxy Proxy False False True SNat SNat) -{-# ANN tb4 (TestBench 'topEntity) #-} - -tb5 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D10 @D5 @2 @100 Proxy Proxy False True True SNat expected - expected = $(Types.expected @D10 @D5 @2 @100 Proxy Proxy False True True SNat SNat) -{-# ANN tb5 (TestBench 'topEntity) #-} - -tb6 = done - where - -- src dst stages samples init reg rstUsed - done = Types.tb @D5 @D11 @2 @100 Proxy Proxy True False True SNat expected - expected = $(Types.expected @D5 @D11 @2 @100 Proxy Proxy True False True SNat SNat) -{-# ANN tb6 (TestBench 'topEntity) #-} - -tb7 = done - where - -- src dst stages samples init reg - done = Types.tb @D11 @D5 @2 @100 Proxy Proxy True True True SNat expected - expected = $(Types.expected @D11 @D5 @2 @100 Proxy Proxy True True True SNat SNat) -{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcPulseTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcPulseTypes.hs deleted file mode 100644 index 1d37f50572..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcPulseTypes.hs +++ /dev/null @@ -1,95 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module XpmCdcPulseTypes where - -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench - -import Data.Proxy -import Language.Haskell.TH.Lib - -import Clash.Cores.Xilinx.Xpm.Cdc.Pulse -import XpmTestCommon - -testData :: KnownDomain dom => Clock dom -> Signal dom (Unsigned 1) -testData clk = genTestData (randomSeed+1) clk - -randomRstSrc :: KnownDomain dom => Clock dom -> Reset dom -randomRstSrc clk = unsafeFromActiveHigh $ genTestData (randomSeed+2) clk - -randomRstDst :: KnownDomain dom => Clock dom -> Reset dom -randomRstDst clk = unsafeFromActiveHigh $ genTestData (randomSeed+3) clk - -tb :: - forall a b stages n . - ( KnownNat n, 1 <= n - , KnownNat stages, 2 <= stages, stages <= 10 - , KnownDomain a - , KnownDomain b - ) => - Proxy a -> Proxy b -> - -- | Initial values - Bool -> - -- | Registered output - Bool -> - -- | Resets used - Bool -> - SNat stages -> - -- | Expected data - Vec n (BitVector 1) -> - Signal b Bool -tb Proxy Proxy initVals regOutput rstUsed SNat expectedDat = done - where - actual = - xpmCdcPulseWith - @stages @(Unsigned 1) - (XpmCdcPulseConfig (SNat @stages) initVals regOutput rstUsed) - clkA rstA clkB rstB (testData clkA) - - done = - outputVerifierWith - (\clk rst -> assertBitVector clk rst $(lift $ "outputVerifier (seed:" <> show randomSeed <> ")")) - clkB clkB noReset - expectedDat - (pack <$> actual) - rstA = randomRstSrc clkA - rstB = unsafeFromActiveHigh $ unsafeSynchronizer clkA clkB $ unsafeToActiveHigh rstA - - -- Testbench clocks - clkA :: Clock a - clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) - clkB :: Clock b - clkB = tbClockGen (not <$> done) - -expected :: - forall a b stages samples . - ( KnownDomain a - , KnownDomain b - , 2 <= stages, stages <= 10 - ) => - Proxy a -> - Proxy b -> - -- | Initial values - Bool -> - -- | Registered output - Bool -> - -- | Resets used - Bool -> - SNat stages -> - SNat samples -> - ExpQ -expected Proxy Proxy initVals regOutput rstUsed SNat SNat = listToVecTH out1 - where - out0 = - xpmCdcPulseWith - @stages @(Unsigned 1) - (XpmCdcPulseConfig (SNat @stages) initVals regOutput rstUsed) - clkA rstA - clkB rstB - (testData clockGen) - clkA = clockGen @a - clkB = clockGen @b - rstA = randomRstSrc clkA - rstB = unsafeFromActiveHigh $ unsafeSynchronizer clkA clkB $ unsafeToActiveHigh rstA - - out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSingle.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcSingle.hs deleted file mode 100644 index 2bb35a6804..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcSingle.hs +++ /dev/null @@ -1,70 +0,0 @@ -module XpmCdcSingle where - -import Clash.Explicit.Prelude - -import Data.Proxy - -import XpmTestCommon (D3, D5, D10, D11) - -import qualified XpmCdcSingleTypes as Types - --- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot --- find the test benches. -topEntity :: Unsigned 1 -topEntity = 0 - -tb0 = done - where - -- src dst stages samples init reg - done = Types.tb @D3 @D5 @4 @100 Proxy Proxy False False SNat expected - expected = $(Types.expected @D3 @D5 @4 @100 Proxy Proxy False False SNat SNat) -{-# ANN tb0 (TestBench 'topEntity) #-} - -tb1 = done - where - -- src dst stages samples init reg - done = Types.tb @D5 @D3 @4 @100 Proxy Proxy False True SNat expected - expected = $(Types.expected @D5 @D3 @4 @100 Proxy Proxy False True SNat SNat) -{-# ANN tb1 (TestBench 'topEntity) #-} - -tb2 = done - where - -- src dst stages samples init reg - done = Types.tb @D3 @D5 @10 @100 Proxy Proxy True False SNat expected - expected = $(Types.expected @D3 @D5 @10 @100 Proxy Proxy True False SNat SNat) -{-# ANN tb2 (TestBench 'topEntity) #-} - -tb3 = done - where - -- src dst stages samples init reg - done = Types.tb @D3 @D5 @2 @100 Proxy Proxy True True SNat expected - expected = $(Types.expected @D3 @D5 @2 @100 Proxy Proxy True True SNat SNat) -{-# ANN tb3 (TestBench 'topEntity) #-} - -tb4 = done - where - -- src dst stages samples init reg - done = Types.tb @D5 @D10 @2 @100 Proxy Proxy False False SNat expected - expected = $(Types.expected @D5 @D10 @2 @100 Proxy Proxy False False SNat SNat) -{-# ANN tb4 (TestBench 'topEntity) #-} - -tb5 = done - where - -- src dst stages samples init reg - done = Types.tb @D10 @D5 @2 @100 Proxy Proxy False True SNat expected - expected = $(Types.expected @D10 @D5 @2 @100 Proxy Proxy False True SNat SNat) -{-# ANN tb5 (TestBench 'topEntity) #-} - -tb6 = done - where - -- src dst stages samples init reg - done = Types.tb @D5 @D11 @2 @100 Proxy Proxy True False SNat expected - expected = $(Types.expected @D5 @D11 @2 @100 Proxy Proxy True False SNat SNat) -{-# ANN tb6 (TestBench 'topEntity) #-} - -tb7 = done - where - -- src dst stages samples init reg - done = Types.tb @D11 @D5 @2 @100 Proxy Proxy True True SNat expected - expected = $(Types.expected @D11 @D5 @2 @100 Proxy Proxy True True SNat SNat) -{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs deleted file mode 100644 index 24c33c756e..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcSingleTypes.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module XpmCdcSingleTypes where - -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench - -import Data.Proxy -import Language.Haskell.TH.Lib - -import Clash.Cores.Xilinx.Xpm.Cdc.Single -import XpmTestCommon - -testData :: KnownDomain dom => Clock dom -> Signal dom (Unsigned 1) -testData = genTestData randomSeed - -tb :: - forall a b stages n . - ( KnownNat n, 1 <= n - , KnownNat stages, 2 <= stages, stages <= 10 - , KnownDomain a - , KnownDomain b - ) => - Proxy a -> Proxy b -> - -- | Initial values - Bool -> - -- | Registered input - Bool -> - SNat stages -> - -- | Expected data - Vec n (BitVector 1) -> - Signal b Bool -tb Proxy Proxy initVals regInput SNat expectedDat = done - where - actual = - xpmCdcSingleWith - @stages @(Unsigned 1) - (XpmCdcSingleConfig SNat initVals regInput) - clkA clkB (testData clkA) - - done = - outputVerifierWith - (\clk rst -> assertBitVector clk rst $(lift $ "outputVerifier (seed:" <> show randomSeed <> ")")) - clkB clkB noReset - expectedDat - (pack <$> actual) - - -- Testbench clocks - clkA :: Clock a - clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) - clkB :: Clock b - clkB = tbClockGen (not <$> done) - -expected :: - forall a b stages samples . - ( KnownDomain a - , KnownDomain b - , 2 <= stages, stages <= 10 - ) => - Proxy a -> - Proxy b -> - -- | Initial values - Bool -> - -- | Registered input - Bool -> - SNat stages -> - SNat samples -> - ExpQ -expected Proxy Proxy initVals regInput SNat SNat = listToVecTH out1 - where - out0 = - xpmCdcSingleWith - @stages @(Unsigned 1) - (XpmCdcSingleConfig SNat initVals regInput) - (clockGen @a) - (clockGen @b) - (testData clockGen) - - out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRst.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRst.hs deleted file mode 100644 index 95d6704ba4..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRst.hs +++ /dev/null @@ -1,71 +0,0 @@ -module XpmCdcSyncRst where - -import Clash.Explicit.Prelude - -import Data.Proxy - -import XpmTestCommon (D3, D5, D10, D11) - -import Clash.Cores.Xilinx.Xpm.Cdc.SyncRst (Asserted(..)) -import qualified XpmCdcSyncRstTypes as Types - --- | This 'topEntity' exists to make @clash-testsuite@ happy. Without it cannot --- find the test benches. -topEntity :: Unsigned 1 -topEntity = 0 - -tb0 = done - where - -- src dst stages samples init - done = Types.tb @D3 @D5 @4 @100 Proxy Proxy Nothing SNat expected - expected = $(Types.expected @D3 @D5 @4 @100 Proxy Proxy Nothing SNat SNat) -{-# ANN tb0 (TestBench 'topEntity) #-} - -tb1 = done - where - -- src dst stages samples init - done = Types.tb @D5 @D3 @4 @100 Proxy Proxy Nothing SNat expected - expected = $(Types.expected @D5 @D3 @4 @100 Proxy Proxy Nothing SNat SNat) -{-# ANN tb1 (TestBench 'topEntity) #-} - -tb2 = done - where - -- src dst stages samples init - done = Types.tb @D3 @D5 @10 @100 Proxy Proxy (Just Asserted) SNat expected - expected = $(Types.expected @D3 @D5 @10 @100 Proxy Proxy (Just Asserted) SNat SNat) -{-# ANN tb2 (TestBench 'topEntity) #-} - -tb3 = done - where - -- src dst stages samples init - done = Types.tb @D3 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat expected - expected = $(Types.expected @D3 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat SNat) -{-# ANN tb3 (TestBench 'topEntity) #-} - -tb4 = done - where - -- src dst stages samples init - done = Types.tb @D5 @D10 @2 @100 Proxy Proxy Nothing SNat expected - expected = $(Types.expected @D5 @D10 @2 @100 Proxy Proxy Nothing SNat SNat) -{-# ANN tb4 (TestBench 'topEntity) #-} - -tb5 = done - where - -- src dst stages samples init - done = Types.tb @D10 @D5 @2 @100 Proxy Proxy Nothing SNat expected - expected = $(Types.expected @D10 @D5 @2 @100 Proxy Proxy Nothing SNat SNat) -{-# ANN tb5 (TestBench 'topEntity) #-} - -tb6 = done - where - -- src dst stages samples init - done = Types.tb @D5 @D11 @2 @100 Proxy Proxy (Just Asserted) SNat expected - expected = $(Types.expected @D5 @D11 @2 @100 Proxy Proxy (Just Asserted) SNat SNat) -{-# ANN tb6 (TestBench 'topEntity) #-} - -tb7 = done - where - -- src dst stages samples init - done = Types.tb @D11 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat expected - expected = $(Types.expected @D11 @D5 @2 @100 Proxy Proxy (Just Deasserted) SNat SNat) -{-# ANN tb7 (TestBench 'topEntity) #-} diff --git a/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRstTypes.hs b/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRstTypes.hs deleted file mode 100644 index f8a2bd738c..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmCdcSyncRstTypes.hs +++ /dev/null @@ -1,79 +0,0 @@ -{-# LANGUAGE BangPatterns #-} - -module XpmCdcSyncRstTypes where - -import Clash.Explicit.Prelude -import Clash.Explicit.Testbench - -import Data.Proxy -import Language.Haskell.TH.Lib - -import Clash.Cores.Xilinx.Xpm.Cdc.SyncRst -import XpmTestCommon - -randomRstSrc :: KnownDomain dom => Clock dom -> Reset dom -randomRstSrc clk = unsafeFromActiveHigh $ genTestData randomSeed clk - -tb :: - forall a b stages n . - ( KnownNat n, 1 <= n - , KnownNat stages, 2 <= stages, stages <= 10 - , KnownDomain a - , KnownDomain b - ) => - Proxy a -> Proxy b -> - -- | Initial values - Maybe Asserted -> - SNat stages -> - -- | Expected data - Vec n (BitVector 1) -> - Signal b Bool -tb Proxy Proxy initVals SNat expectedDat = done - where - actual = - xpmCdcSyncRstWith - @stages - (XpmCdcSyncRstConfig (SNat @stages) initVals) - clkA clkB (randomRstSrc clkA) - - done = - outputVerifierWith - (\clk rst -> assertBitVector clk rst $(lift $ "outputVerifier (seed:" <> show randomSeed <> ")")) - clkB clkB noReset - expectedDat - (pack <$> unsafeToActiveHigh actual) - rstA = randomRstSrc clkA - rstB = unsafeFromActiveHigh $ unsafeSynchronizer clkA clkB $ unsafeToActiveHigh rstA - - -- Testbench clocks - clkA :: Clock a - clkA = tbClockGen (not <$> unsafeSynchronizer clkB clkA done) - clkB :: Clock b - clkB = tbClockGen (not <$> done) - -expected :: - forall a b stages samples . - ( KnownDomain a - , KnownDomain b - , 2 <= stages, stages <= 10 - ) => - Proxy a -> - Proxy b -> - -- | Initial values - Maybe Asserted -> - SNat stages -> - SNat samples -> - ExpQ -expected Proxy Proxy initVals SNat SNat = listToVecTH out1 - where - out0 = unsafeToActiveHigh $ - xpmCdcSyncRstWith - @stages - (XpmCdcSyncRstConfig (SNat @stages) initVals) - clkA - clkB - (randomRstSrc clkA) - clkA = clockGen @a - clkB = clockGen @b - - out1 = pack <$> sampleN (natToNum @samples) out0 diff --git a/tests/shouldwork/Cores/Xilinx/XpmTestCommon.hs b/tests/shouldwork/Cores/Xilinx/XpmTestCommon.hs deleted file mode 100644 index 1fed722baf..0000000000 --- a/tests/shouldwork/Cores/Xilinx/XpmTestCommon.hs +++ /dev/null @@ -1,30 +0,0 @@ -{-# OPTIONS_GHC -Wno-orphans #-} -{-# OPTIONS_GHC -fforce-recomp #-} -module XpmTestCommon where - -import Clash.Explicit.Prelude -import Language.Haskell.TH (runIO) -import System.Random - - -createDomain vXilinxSystem{vName="D3", vPeriod=hzToPeriod 30e6} -createDomain vXilinxSystem{vName="D5", vPeriod=hzToPeriod 50e6} -createDomain vXilinxSystem{vName="D10", vPeriod=hzToPeriod 100e6} -createDomain vXilinxSystem{vName="D11", vPeriod=hzToPeriod 110e6} - -randomSeed :: Int -randomSeed = $(runIO (randomIO @Int) >>= lift) - -genTestData :: forall dom a z. (KnownDomain dom, BitPack a, BitSize a <= 64) => Int -> Clock dom -> Signal dom a -genTestData seed clk = (unpack . truncateToSize . pack) <$> out - where - (out,gen) = unbundle $ genWord64 <$> delay clk enableGen (mkStdGen seed) gen - truncateToSize :: BitVector 64 -> BitVector (BitSize a) - truncateToSize = leToPlus @(BitSize a) @64 truncateB - --- dummy implementation -instance NFDataX StdGen where - deepErrorX = errorX - hasUndefined = const False - ensureSpine = id - rnfX = const ()