From be30efcf184ac675079ba203aa9335ce31261da6 Mon Sep 17 00:00:00 2001 From: Lara Herzog Date: Wed, 18 Sep 2024 17:17:50 +0200 Subject: [PATCH] add pre-processing --- bittide-experiments/bittide-experiments.cabal | 1 + bittide-experiments/src/Bittide/Hitl.hs | 20 +- bittide-instances/bittide-instances.cabal | 2 + .../src/Bittide/Instances/Hitl/BoardTest.hs | 12 +- .../src/Bittide/Instances/Hitl/FincFdec.hs | 1 + .../Bittide/Instances/Hitl/FullMeshHwCc.hs | 2 + .../Bittide/Instances/Hitl/FullMeshSwCc.hs | 2 + .../Bittide/Instances/Hitl/HwCcTopologies.hs | 3 + .../Instances/Hitl/LinkConfiguration.hs | 2 + .../src/Bittide/Instances/Hitl/Pre/Program.hs | 201 ++++++++++++++++++ .../Bittide/Instances/Hitl/SyncInSyncOut.hs | 2 + .../Instances/Hitl/TemperatureMonitor.hs | 3 + .../Bittide/Instances/Hitl/Transceivers.hs | 2 + .../src/Bittide/Instances/Hitl/VexRiscv.hs | 164 ++------------ bittide-shake/src/Clash/Shake/Vivado.hs | 37 +++- 15 files changed, 304 insertions(+), 150 deletions(-) create mode 100644 bittide-instances/src/Bittide/Instances/Hitl/Pre/Program.hs diff --git a/bittide-experiments/bittide-experiments.cabal b/bittide-experiments/bittide-experiments.cabal index e39e2619a..86821af28 100644 --- a/bittide-experiments/bittide-experiments.cabal +++ b/bittide-experiments/bittide-experiments.cabal @@ -106,6 +106,7 @@ library text, typelits-witnesses, vector, + vivado-hs, exposed-modules: Bittide.Github.Artifacts diff --git a/bittide-experiments/src/Bittide/Hitl.hs b/bittide-experiments/src/Bittide/Hitl.hs index 271b82124..775f2f513 100644 --- a/bittide-experiments/src/Bittide/Hitl.hs +++ b/bittide-experiments/src/Bittide/Hitl.hs @@ -46,6 +46,7 @@ module Bittide.Hitl ( -- * Test definition HitlTestGroup (..), HitlTestCase (..), + CasePreProcessing (..), MayHavePostProcData (..), Done, Success, @@ -78,6 +79,9 @@ import Data.Map.Strict qualified as Map import System.Exit (ExitCode) +import Vivado (VivadoHandle) +import Vivado.Tcl (HwTarget) + {- | Fully qualified name to a function that is the target for Clash compilation. E.g. @Bittide.Foo.topEntity@. -} @@ -177,10 +181,12 @@ data HitlTestGroup where , extraXdcFiles :: [String] , testCases :: [HitlTestCase HwTargetRef a b] -- ^ List of test cases + , mPreProc :: Maybe (VivadoHandle -> String -> HwTarget -> IO ()) + -- ^ Optional pre-processing step. First argument is the name of the test , mPostProc :: Maybe (FilePath -> ExitCode -> IO ()) -- ^ Optional post processing step. , externalHdl :: [String] - -- ^ List of external HDL files to include in the project + -- ^ List of external HDL files to include in he project } -> HitlTestGroup @@ -192,12 +198,23 @@ data HitlTestCase h a b where (Show h, Show a, BitPack a, Show b, Typeable h) => { name :: String , parameters :: Map h a + , preProc :: CasePreProcessing , postProcData :: b } -> HitlTestCase h a b deriving instance Show (HitlTestCase h a b) +data CasePreProcessing + = NoPreProcess + | InheritPreProcess + | CustomPreProcess (VivadoHandle -> HwTarget -> IO ()) + +instance Show CasePreProcessing where + show NoPreProcess = "NoPreProcess" + show InheritPreProcess = "InheritPreProcess" + show (CustomPreProcess _) = "CustomPreProcess " + -- | A class for extracting optional post processing data from a test. class MayHavePostProcData b where -- | Returns the test names with some post processing data of type @c@, @@ -252,6 +269,7 @@ testCasesFromEnum hwTs ppd = { name = show constr , parameters = Map.fromList ((,constr) <$> hwTs) , postProcData = ppd + , preProc = InheritPreProcess } | (constr :: a) <- [minBound ..] ] diff --git a/bittide-instances/bittide-instances.cabal b/bittide-instances/bittide-instances.cabal index 4497d2cbb..25824d72a 100644 --- a/bittide-instances/bittide-instances.cabal +++ b/bittide-instances/bittide-instances.cabal @@ -110,6 +110,7 @@ common common-options text, unix, vector, + vivado-hs, library import: common-options @@ -126,6 +127,7 @@ library Bittide.Instances.Hitl.LinkConfiguration Bittide.Instances.Hitl.Post.BoardTestExtended Bittide.Instances.Hitl.Post.PostProcess + Bittide.Instances.Hitl.Pre.Program Bittide.Instances.Hitl.Setup Bittide.Instances.Hitl.SyncInSyncOut Bittide.Instances.Hitl.TemperatureMonitor diff --git a/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs b/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs index 52c90eacc..3da06adf7 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs @@ -22,8 +22,9 @@ import Bittide.Instances.Hitl.Post.BoardTestExtended import Bittide.Instances.Hitl.Post.PostProcess import Bittide.Hitl ( - HitlTestCase (HitlTestCase), + HitlTestCase (..), HitlTestGroup (..), + CasePreProcessing (..), hitlVio, hitlVioBool, paramForHwTargets, @@ -181,7 +182,13 @@ testSimple = { topEntity = 'boardTestSimple , extraXdcFiles = [] , externalHdl = [] - , testCases = [HitlTestCase "Simple" (paramForHwTargets allHwTargets ()) ()] + , testCases = [HitlTestCase + { name = "Simple" + , parameters = (paramForHwTargets allHwTargets ()) + , postProcData = () + , preProc = InheritPreProcess + }] + , mPreProc = Nothing , mPostProc = Nothing } @@ -192,6 +199,7 @@ testExtended = , extraXdcFiles = [] , externalHdl = [] , testCases = testCasesFromEnum @Test allHwTargets () + , mPreProc = Nothing , mPostProc = Just postBoardTestExtendedFunc } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs index 795235ea1..e480b50bb 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs @@ -222,5 +222,6 @@ tests = , extraXdcFiles = [] , externalHdl = [] , testCases = testCasesFromEnum @Test [HwTargetByIndex 7] () + , mPreProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs index 560fd126b..73e128f66 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs @@ -519,8 +519,10 @@ mkTest topEntity = , clockOffsets = Nothing , startupDelays = toList $ repeat @FpgaCount 0 } + , preProc = InheritPreProcess } ] + , mPreProc = Nothing , mPostProc = Nothing } where diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs index 2d3d8c751..c1c9fca91 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs @@ -688,9 +688,11 @@ tests = , clockOffsets = Nothing , startupDelays = toList $ repeat @FpgaCount 0 } + , preProc = InheritPreProcess } | n <- [0 .. testsToRun - 1] ] + , mPreProc = Nothing , mPostProc = Nothing } where diff --git a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs index 71b13a4cc..b246f38c5 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs @@ -840,6 +840,7 @@ tests = testGroup , clockOffsets = Nothing , startupDelays = toList $ repeat @FpgaCount 0 } + , preProc = InheritPreProcess } -- tests the given topology @@ -873,6 +874,7 @@ tests = testGroup , clockOffsets = toList <$> clockShifts , startupDelays = fromIntegral <$> toList startDelays } + , preProc = InheritPreProcess } maybeVecToVecMaybe :: forall n a. (KnownNat n) => Maybe (Vec n a) -> Vec n (Maybe a) @@ -919,6 +921,7 @@ tests = testGroup -- make sure the clock offsets detected during calibration is still the same , validateClockOffsetCalibration ] + , mPreProc = Nothing , mPostProc = Nothing } {- FOURMOLU_ENABLE -} diff --git a/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs b/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs index 7d19f97bf..23af079da 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs @@ -285,7 +285,9 @@ tests = | i <- [0 ..] :: [Index FpgaCount] ] , postProcData = () + , preProc = InheritPreProcess } ] + , mPreProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Pre/Program.hs b/bittide-instances/src/Bittide/Instances/Hitl/Pre/Program.hs new file mode 100644 index 000000000..860a3b7e9 --- /dev/null +++ b/bittide-instances/src/Bittide/Instances/Hitl/Pre/Program.hs @@ -0,0 +1,201 @@ +module Bittide.Instances.Hitl.Pre.Program where + +import Prelude + +import Paths_bittide_instances + +import Control.Monad (unless) +import Control.Monad.Extra (forM_) +import Data.List.Extra (isPrefixOf, trim) +import Data.Maybe (fromJust) +import System.IO +import System.IO.Temp +import System.Process + +import Test.Tasty.HUnit + +data Error = Ok | Error String +data Filter = Continue | Stop Error + +getOpenOcdStartPath :: IO FilePath +getOpenOcdStartPath = getDataFileName "data/openocd/start.sh" + +getGdbProgPath :: IO FilePath +getGdbProgPath = getDataFileName "data/gdb/test-gdb-prog" + +getPicocomStartPath :: IO FilePath +getPicocomStartPath = getDataFileName "data/picocom/start.sh" + +-- \| XXX: Currently hardcoded to a very specific position. Maybe we could probe +-- using JTAG to see what device we're connected to? +-- +getUartDev :: IO String +getUartDev = pure "/dev/serial/by-path/pci-0000:00:14.0-usb-0:5.1:1.1-port0" + +-- \| Copy the GDB program obtained from 'getGdbProgPath' to a temporary file, +-- prepend each non-comment, non-empty line with 'echo > {line}\n'. This effectively +-- emulates Bash's 'set -x' for the GDB program. This can in turn be used to +-- wait for specific commands to be executed, or simply for debugging. +-- +withAnnotatedGdbProgPath :: FilePath -> (String -> IO ()) -> IO () +withAnnotatedGdbProgPath srcPath action = do + withSystemTempFile "test-gdb-prog" $ \dstPath dstHandle -> do + withFile srcPath ReadMode $ \srcHandle -> do + srcLines <- lines <$> hGetContents srcHandle + forM_ srcLines $ \line -> do + let trimmedLine = trim line + unless + (null trimmedLine || "#" `isPrefixOf` trimmedLine) + ( hPutStr dstHandle "echo > " + >> hPutStr dstHandle line + >> hPutStrLn dstHandle "\\n" + ) + hPutStrLn dstHandle line + + hClose dstHandle + action dstPath + +-- \| Utility function that reads lines from a handle, and applies a filter to +-- each line. If the filter returns 'Continue', the function will continue +-- reading lines. If the filter returns @Stop Ok@, the function will return +-- successfully. If the filter returns @Stop (Error msg)@, the function will +-- fail with the given message. +-- +expectLine :: (HasCallStack) => Handle -> (String -> Filter) -> IO () +expectLine h f = do + line <- trim <$> hGetLine h + let cont = expectLine h f + if null line + then cont + else case f line of + Continue -> cont + Stop Ok -> pure () + Stop (Error msg) -> assertFailure msg + +-- \| Utility function that reads lines from a handle, and waits for a specific +-- line to appear. Though this function does not fail in the traditional sense, +-- it will get stuck if the expected line does not appear. Only use in combination +-- with sensible time outs (also see 'main'). +-- +waitForLine :: Handle -> String -> IO () +waitForLine h expected = + expectLine h $ \s -> + if s == expected + then Stop Ok + else Continue + +-- \| Test that the GDB program works as expected. This test will start OpenOCD, +-- Picocom, and GDB, and will wait for the GDB program to execute specific +-- commands. This test will fail if any of the processes fail, or if the GDB +-- program does not execute the expected commands. +-- +-- OpenOCD: A program that communicates with the FPGA over JTAG. When it starts +-- it will \"interrogate\" the JTAG chain - making sure it can read our +-- CPU's ID. After that, it will open a GDB server on port 3333. +-- +-- Picocom: A program that communicates with the FPGA over UART. +-- +-- GDB: GNU Debugger. This program will connect to the OpenOCD server and is able +-- to, amongst other things, load programs, set break points, and step +-- through code. +-- + +{- +case_testGdbProgram :: Assertion +case_testGdbProgram = do + startOpenOcdPath <- getOpenOcdStartPath + startPicocomPath <- getPicocomStartPath + uartDev <- getUartDev + + gdbProc <- getGdbProgPath + + withAnnotatedGdbProgPath gdbProc $ \gdbProgPath -> do + let + openOcdProc = (proc startOpenOcdPath []){std_err = CreatePipe} + picocomProc = (proc startPicocomPath [uartDev]){std_out = CreatePipe, std_in = CreatePipe} + gdbProc = (proc "gdb" ["--command", gdbProgPath]){std_out = CreatePipe, std_err = CreatePipe} + + -- Wait until we see "Halting processor", fail if we see an error + waitForHalt s + | "Error:" `isPrefixOf` s = Stop (Error ("Found error in OpenOCD output: " <> s)) + | "Halting processor" `isPrefixOf` s = Stop Ok + | otherwise = Continue + + withCreateProcess openOcdProc $ \_ _ (fromJust -> openOcdStdErr) _ -> do + hSetBuffering openOcdStdErr LineBuffering + expectLine openOcdStdErr waitForHalt + + -- XXX: Picocom doesn't immediately clean up after closing, because it + -- spawns as a child of the shell (start.sh). We could use 'exec' to + -- make sure the intermediate shell doesn't exist, but this causes + -- the whole test program to exit with signal 15 (??????). + withCreateProcess picocomProc $ \maybePicocomStdIn maybePicocomStdOut _ _ -> do + let + picocomStdIn = fromJust maybePicocomStdIn + picocomStdOut = fromJust maybePicocomStdOut + + hSetBuffering picocomStdIn LineBuffering + hSetBuffering picocomStdOut LineBuffering + + waitForLine picocomStdOut "Terminal ready" + + withCreateProcess gdbProc $ \_ (fromJust -> gdbStdOut) _ _ -> do + -- Wait for GDB to program the FPGA. If successful, we should see + -- "going in echo mode" in the picocom output. + hSetBuffering gdbStdOut LineBuffering + waitForLine picocomStdOut "Going in echo mode!" + + -- Wait for GDB to reach its last command - where it will wait indefinitely + waitForLine gdbStdOut "> continue" + + -- Test UART echo + hPutStrLn picocomStdIn "Hello, UART!" + waitForLine picocomStdOut "Hello, UART!" +-} + +runGdbPicocomOpenOcd :: + -- | Path to the GDB script to run + FilePath -> + (Handle -> (Handle, Handle) -> IO ()) -> + IO () +runGdbPicocomOpenOcd gdbScript action = do + startOpenOcdPath <- getOpenOcdStartPath + startPicocomPath <- getPicocomStartPath + uartDev <- getUartDev + + withAnnotatedGdbProgPath gdbScript $ \gdbProgPath -> do + let + openOcdProc = (proc startOpenOcdPath []){std_err = CreatePipe} + picocomProc = (proc startPicocomPath [uartDev]){std_out = CreatePipe, std_in = CreatePipe} + gdbProc = (proc "gdb" ["--command", gdbProgPath]){std_out = CreatePipe, std_err = CreatePipe} + + + withCreateProcess openOcdProc $ \_ _ (fromJust -> openOcdStdErr) _ -> do + let + -- Wait until we see "Halting processor", fail if we see an error + waitForHalt s + | "Error:" `isPrefixOf` s = Stop (Error ("Found error in OpenOCD output: " <> s)) + | "Halting processor" `isPrefixOf` s = Stop Ok + | otherwise = Continue + + hSetBuffering openOcdStdErr LineBuffering + expectLine openOcdStdErr waitForHalt + + -- XXX: Picocom doesn't immediately clean up after closing, because it + -- spawns as a child of the shell (start.sh). We could use 'exec' to + -- make sure the intermediate shell doesn't exist, but this causes + -- the whole test program to exit with signal 15 (??????). + withCreateProcess picocomProc $ \maybePicocomStdIn maybePicocomStdOut _ _ -> do + let + picocomStdIn = fromJust maybePicocomStdIn + picocomStdOut = fromJust maybePicocomStdOut + + hSetBuffering picocomStdIn LineBuffering + hSetBuffering picocomStdOut LineBuffering + + waitForLine picocomStdOut "Terminal ready" + + withCreateProcess gdbProc $ \_ (fromJust -> gdbStdOut) _ _ -> do + + hSetBuffering gdbStdOut LineBuffering + action gdbStdOut (picocomStdIn, picocomStdOut) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs b/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs index 4939e59d9..de976af26 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs @@ -168,7 +168,9 @@ tests = { name = "SyncInSyncOut" , parameters = paramForHwTargets allHwTargets () , postProcData = () + , preProc = InheritPreProcess } ] + , mPreProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs b/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs index e2b0d9b70..bbf836fa7 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs @@ -22,6 +22,7 @@ import Bittide.Hitl ( HitlTestGroup (..), hitlVioBool, paramForHwTargets, + CasePreProcessing (..), ) import Bittide.Instances.Hitl.Setup (allHwTargets) @@ -111,7 +112,9 @@ tests = { name = "TemperatureMonitor" , parameters = paramForHwTargets allHwTargets () , postProcData = () + , preProc = InheritPreProcess } ] + , mPreProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs b/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs index c3bfcfacd..e3f4ec1e1 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs @@ -233,6 +233,7 @@ tests = , externalHdl = [] , extraXdcFiles = [] , testCases = iters + , mPreProc = Nothing , mPostProc = Nothing } where @@ -245,6 +246,7 @@ tests = , parameters = Map.fromList (L.zip (HwTargetByIndex . fromIntegral <$> fpgaIndices) fpgaIndices) , postProcData = () + , preProc = InheritPreProcess } | nm <- iterNames ] diff --git a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs index 744e0bea1..b39082124 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs @@ -21,29 +21,20 @@ import Protocols import Protocols.Wishbone import VexRiscv +import Vivado (VivadoHandle) +import Vivado.Tcl (HwTarget) + import Bittide.DoubleBufferedRam import Bittide.Hitl import Bittide.Instances.Domains (Basic125, Ext125) +import Bittide.Instances.Hitl.Pre.Program import Bittide.ProcessingElement import Bittide.SharedTypes import Bittide.Wishbone -import System.Exit (ExitCode (..)) - import Paths_bittide_instances -import Control.Monad (unless) -import Control.Monad.Extra (forM_) -import Data.List.Extra (isPrefixOf, trim) -import Data.Maybe (fromJust) import System.IO -import System.IO.Temp -import System.Process - -import Test.Tasty.HUnit - -data Error = Ok | Error String -data Filter = Continue | Stop Error data TestStatus = Running | Success | Fail deriving (Enum, Eq, Generic, NFDataX, BitPack) @@ -177,142 +168,27 @@ tests = { name = "VexRiscV" , parameters = paramForSingleHwTarget (HwTargetByIndex 7) () , postProcData = () + , preProc = InheritPreProcess } ] - , mPostProc = Just postProcessFunc + , mPreProc = Just preProcessFunc + , mPostProc = Nothing } -postProcessFunc :: FilePath -> ExitCode -> IO () -postProcessFunc _ilaPath _code = case_testGdbProgram - where - getOpenOcdStartPath :: IO FilePath - getOpenOcdStartPath = getDataFileName "data/openocd/start.sh" - - getPicocomStartPath :: IO FilePath - getPicocomStartPath = getDataFileName "data/picocom/start.sh" - - getGdbProgPath :: IO FilePath - getGdbProgPath = getDataFileName "data/gdb/test-gdb-prog" - - -- \| XXX: Currently hardcoded to a very specific position. Maybe we could probe - -- using JTAG to see what device we're connected to? - -- - getUartDev :: IO String - getUartDev = pure "/dev/serial/by-path/pci-0000:00:14.0-usb-0:5.1:1.1-port0" - - -- \| Copy the GDB program obtained from 'getGdbProgPath' to a temporary file, - -- prepend each non-comment, non-empty line with 'echo > {line}\n'. This effectively - -- emulates Bash's 'set -x' for the GDB program. This can in turn be used to - -- wait for specific commands to be executed, or simply for debugging. - -- - withAnnotatedGdbProgPath :: (String -> IO ()) -> IO () - withAnnotatedGdbProgPath action = do - srcPath <- getGdbProgPath - withSystemTempFile "test-gdb-prog" $ \dstPath dstHandle -> do - withFile srcPath ReadMode $ \srcHandle -> do - srcLines <- lines <$> hGetContents srcHandle - forM_ srcLines $ \line -> do - let trimmedLine = trim line - unless - (null trimmedLine || "#" `isPrefixOf` trimmedLine) - ( hPutStr dstHandle "echo > " - >> hPutStr dstHandle line - >> hPutStrLn dstHandle "\\n" - ) - hPutStrLn dstHandle line - - hClose dstHandle - action dstPath - - -- \| Utility function that reads lines from a handle, and applies a filter to - -- each line. If the filter returns 'Continue', the function will continue - -- reading lines. If the filter returns @Stop Ok@, the function will return - -- successfully. If the filter returns @Stop (Error msg)@, the function will - -- fail with the given message. - -- - expectLine :: (HasCallStack) => Handle -> (String -> Filter) -> IO () - expectLine h f = do - line <- trim <$> hGetLine h - let cont = expectLine h f - if null line - then cont - else case f line of - Continue -> cont - Stop Ok -> pure () - Stop (Error msg) -> assertFailure msg - - -- \| Utility function that reads lines from a handle, and waits for a specific - -- line to appear. Though this function does not fail in the traditional sense, - -- it will get stuck if the expected line does not appear. Only use in combination - -- with sensible time outs (also see 'main'). - -- - waitForLine :: Handle -> String -> IO () - waitForLine h expected = - expectLine h $ \s -> - if s == expected - then Stop Ok - else Continue - - -- \| Test that the GDB program works as expected. This test will start OpenOCD, - -- Picocom, and GDB, and will wait for the GDB program to execute specific - -- commands. This test will fail if any of the processes fail, or if the GDB - -- program does not execute the expected commands. - -- - -- OpenOCD: A program that communicates with the FPGA over JTAG. When it starts - -- it will \"interrogate\" the JTAG chain - making sure it can read our - -- CPU's ID. After that, it will open a GDB server on port 3333. - -- - -- Picocom: A program that communicates with the FPGA over UART. - -- - -- GDB: GNU Debugger. This program will connect to the OpenOCD server and is able - -- to, amongst other things, load programs, set break points, and step - -- through code. - -- - case_testGdbProgram :: Assertion - case_testGdbProgram = do - startOpenOcdPath <- getOpenOcdStartPath - startPicocomPath <- getPicocomStartPath - uartDev <- getUartDev - - withAnnotatedGdbProgPath $ \gdbProgPath -> do - let - openOcdProc = (proc startOpenOcdPath []){std_err = CreatePipe} - picocomProc = (proc startPicocomPath [uartDev]){std_out = CreatePipe, std_in = CreatePipe} - gdbProc = (proc "gdb" ["--command", gdbProgPath]){std_out = CreatePipe, std_err = CreatePipe} - - -- Wait until we see "Halting processor", fail if we see an error - waitForHalt s - | "Error:" `isPrefixOf` s = Stop (Error ("Found error in OpenOCD output: " <> s)) - | "Halting processor" `isPrefixOf` s = Stop Ok - | otherwise = Continue - - withCreateProcess openOcdProc $ \_ _ (fromJust -> openOcdStdErr) _ -> do - hSetBuffering openOcdStdErr LineBuffering - expectLine openOcdStdErr waitForHalt - - -- XXX: Picocom doesn't immediately clean up after closing, because it - -- spawns as a child of the shell (start.sh). We could use 'exec' to - -- make sure the intermediate shell doesn't exist, but this causes - -- the whole test program to exit with signal 15 (??????). - withCreateProcess picocomProc $ \maybePicocomStdIn maybePicocomStdOut _ _ -> do - let - picocomStdIn = fromJust maybePicocomStdIn - picocomStdOut = fromJust maybePicocomStdOut - - hSetBuffering picocomStdIn LineBuffering - hSetBuffering picocomStdOut LineBuffering - waitForLine picocomStdOut "Terminal ready" +preProcessFunc :: VivadoHandle -> String -> HwTarget -> IO () +preProcessFunc _v _name _hwT = do + gdbScript <- getDataFileName "data/gdb/test-gdb-prog" - withCreateProcess gdbProc $ \_ (fromJust -> gdbStdOut) _ _ -> do - -- Wait for GDB to program the FPGA. If successful, we should see - -- "going in echo mode" in the picocom output. - hSetBuffering gdbStdOut LineBuffering - waitForLine picocomStdOut "Going in echo mode!" + runGdbPicocomOpenOcd gdbScript $ \gdbOut (picocomIn, picocomOut) -> do + -- This is the first thing that will print when the FPGA has been programmed + -- and starts executing the new program. + waitForLine picocomOut "Going in echo mode!" - -- Wait for GDB to reach its last command - where it will wait indefinitely - waitForLine gdbStdOut "> continue" + -- Wait for GDB to reach its last command - where it will wait indefinitely + waitForLine gdbOut "> continue" - -- Test UART echo - hPutStrLn picocomStdIn "Hello, UART!" - waitForLine picocomStdOut "Hello, UART!" + -- Test UART echo + hPutStrLn picocomIn "Hello, UART!" + waitForLine picocomOut "Hello, UART!" + pure () diff --git a/bittide-shake/src/Clash/Shake/Vivado.hs b/bittide-shake/src/Clash/Shake/Vivado.hs index 5fa9831d2..a7204cb0f 100644 --- a/bittide-shake/src/Clash/Shake/Vivado.hs +++ b/bittide-shake/src/Clash/Shake/Vivado.hs @@ -786,7 +786,7 @@ runHitlTest :: -- | Filepath the the ILA data dump directory FilePath -> IO ExitCode -runHitlTest test@HitlTestGroup{topEntity, testCases} url probesFilePath ilaDataDir = do +runHitlTest test@HitlTestGroup{topEntity, testCases, mPreProc} url probesFilePath ilaDataDir = do putStrLn $ "Starting HITL test for FPGA design '" <> show topEntity @@ -804,6 +804,8 @@ runHitlTest test@HitlTestGroup{topEntity, testCases} url probesFilePath ilaDataD execCmd_ v "connect_hw_server" ["-url " <> url] refToHwTMap <- resolveHwTRefs v (hwTargetRefsFromHitlTestGroup test) + + testResults <- forM (zip [1 :: Int ..] testCases) $ \(nr, HitlTestCase{..}) -> do putStrLn $ "Starting HITL test case " @@ -825,7 +827,7 @@ runHitlTest test@HitlTestGroup{topEntity, testCases} url probesFilePath ilaDataD { parameters = mapKeys (fromJust . (`Map.lookup` refToHwTMap)) parameters , .. } - exitCode <- runHitlTestCase v resolvedTestCase probesFilePath ilaDataDir + exitCode <- runHitlTestCase v resolvedTestCase mPreProc probesFilePath ilaDataDir pure (name, exitCode) let failedTestCaseNames = fst <$> filter ((/= ExitSuccess) . snd) testResults @@ -854,12 +856,14 @@ runHitlTestCase :: VivadoHandle -> -- | The HITL test case to run HitlTestCase HwTarget a b -> + -- | Pre-process function for the test group + Maybe (VivadoHandle -> String -> HwTarget -> IO ()) -> -- | Path to the generated probes file FilePath -> -- | Filepath the the ILA data dump directory FilePath -> IO ExitCode -runHitlTestCase v testCase@HitlTestCase{..} probesFilePath ilaDataDir = do +runHitlTestCase v testCase@HitlTestCase{..} preProcessFunc probesFilePath ilaDataDir = do if null parameters then do putStrLn @@ -901,6 +905,7 @@ runHitlTestCase v testCase@HitlTestCase{..} probesFilePath ilaDataDir = do ilas <- get_hw_ilas v [] unless (null ilas) $ putStrLn "Configuring and arming ILAs..." + forM_ ilas $ \ila -> do _ <- current_hw_ila v [show ila] @@ -925,6 +930,23 @@ runHitlTestCase v testCase@HitlTestCase{..} probesFilePath ilaDataDir = do execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] commit_hw_vio v ["[get_hw_vios]"] + -- run pre-processing + case preProc of + NoPreProcess -> pure () + InheritPreProcess -> case preProcessFunc of + Just f -> do + putStrLn $ + "Running test-group pre-process function for " + <> name <> " ('" <> prettyShow hwT <> "')" + f v name hwT + Nothing -> pure () + CustomPreProcess f -> do + putStrLn $ + "Running case pre-process function for " + <> name <> " ('" <> prettyShow hwT <> "')" + f v hwT + + -- Assert HitlVio start probe execCmd_ v "set_property" ["OUTPUT_VALUE", "1", getProbeTestStartTcl] commit_hw_vio v ["[get_hw_vios]"] @@ -952,4 +974,13 @@ runHitlTestCase v testCase@HitlTestCase{..} probesFilePath ilaDataDir = do execCmd_ v "write_hw_ila_data" ["-force", "-legacy_csv_file " <> dir ilaShortName] execCmd_ v "write_hw_ila_data" ["-force", "-vcd_file " <> dir ilaShortName] + -- deassert all START signals + forM_ (sortOn (prettyShow . fst) (toAscList parameters)) $ \(hwT, _param) -> do + openHwT v hwT + execCmd_ v "set_property" ["PROBES.FILE", embrace probesFilePath, "[current_hw_device]"] + refresh_hw_device v [] + + execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] + commit_hw_vio v ["[get_hw_vios]"] + pure testCaseExitCode