use functions instead of binary-names for post-processing

.github/synthesis/debug.json

@@ -0,0 +1,14 @@
+[
+  {
+    "top": "boardTestExtended",
+    "stage": "test"
+  },
+  {
+    "top": "boardTestSimple",
+    "stage": "test"
+  },
+  {
+    "top": "vexRiscvTest",
+    "stage": "test"
+  }
+]

bittide-experiments/src/Bittide/Hitl.hs

@@ -76,6 +76,8 @@ import Numeric.Natural (Natural)
 import Clash.Prelude qualified as P
 import Data.Map.Strict qualified as Map
 
+import System.Exit (ExitCode)
+
 {- | Fully qualified name to a function that is the target for Clash
 compilation. E.g. @Bittide.Foo.topEntity@.
 -}
@@ -161,6 +163,7 @@ and requires a (hypothetical) 8-bit number indicating the
 >           , postProcData = ()
 >           }
 >       ]
+>   , mPreProc = Nothing
 >   , mPostProc = Nothing
 >   }
 
@@ -174,9 +177,8 @@ data HitlTestGroup where
     , extraXdcFiles :: [String]
     , testCases :: [HitlTestCase HwTargetRef a b]
     -- ^ List of test cases
-    , mPostProc :: Maybe String
-    -- ^ Optional post processing step. If present, the name of the executable
-    -- in the @bittide-instances@ package.
+    , mPostProc :: Maybe (FilePath -> ExitCode -> IO ())
+    -- ^ Optional post processing step.
     , externalHdl :: [String]
     -- ^ List of external HDL files to include in the project
     } ->

bittide-instances/bittide-instances.cabal

@@ -72,6 +72,7 @@ common common-options
 
   default-language: Haskell2010
   build-depends:
+    Glob,
     MissingH,
     aeson,
     base,
@@ -97,11 +98,15 @@ common common-options
     ghc-typelits-natnormalise,
     lift-type,
     pretty-simple,
+    process,
     shake,
     split,
     string-interpolate,
+    tasty,
     tasty-hunit,
+    tasty-th,
     template-haskell,
+    temporary,
     text,
     unix,
     vector,

bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs

@@ -14,6 +14,13 @@ import Clash.Annotations.TH (makeTopEntity)
 import Clash.Cores.Xilinx.Extra (ibufds)
 import Clash.Cores.Xilinx.Ila
 
+import System.Exit (ExitCode)
+import System.FilePath ((</>))
+import System.FilePath.Glob (glob)
+
+import Bittide.Instances.Hitl.Post.BoardTestExtended
+import Bittide.Instances.Hitl.Post.PostProcess
+
 import Bittide.Hitl (
   HitlTestCase (HitlTestCase),
   HitlTestGroup (..),
@@ -185,5 +192,11 @@ testExtended =
     , extraXdcFiles = []
     , externalHdl = []
     , testCases = testCasesFromEnum @Test allHwTargets ()
-    , mPostProc = Just "post-board-test-extended"
+    , mPostProc = Just postBoardTestExtendedFunc
     }
+
+postBoardTestExtendedFunc :: FilePath -> ExitCode -> IO ()
+postBoardTestExtendedFunc ilaDir exitCode = do
+  csvPaths <- glob (ilaDir </> "*" </> "*" </> "*.csv")
+  let ilaCsvPaths = toFlattenedIlaCsvPathList ilaDir csvPaths
+  postBoardTestExtended exitCode ilaCsvPaths

bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs

@@ -28,6 +28,23 @@ 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)
 
@@ -162,5 +179,140 @@ tests =
             , postProcData = ()
             }
         ]
-    , mPostProc = Just "post-vex-riscv-test"
+    , mPostProc = Just postProcessFunc
     }
+
+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"
+
+          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!"

bittide-shake/exe/Main.hs

@@ -107,6 +107,11 @@ doPostProcessing postProcessMain ilaDataDir testExitCode = do
   callProcess "cabal" ["build", postProcessMain]
   callProcess "cabal" ["run", postProcessMain, ilaDataDir, show testExitCode]
 
+doPreProcessing :: String -> Assertion
+doPreProcessing preProcessMain = do
+  callProcess "cabal" ["build", preProcessMain]
+  callProcess "cabal" ["run", preProcessMain]
+
 {- | Searches for a file called @cabal.project@ It will look for it in the
 current working directory. If it can't find it there, it will traverse up
 until it finds the file.
@@ -140,8 +145,8 @@ data Target = Target
   , targetTest :: Maybe HitlTestGroup
   -- ^ Whether target has a VIO probe that can be used to run hardware-in-the-
   -- loop tests. Note that this flag, 'targetTest', implies 'targetHasVio'.
-  , targetPostProcess :: Maybe String
-  -- ^ Name of the executable for post processing of ILA CSV data, or Nothing
+  , targetPostProcess :: Maybe (FilePath -> ExitCode -> IO ())
+  -- ^ Function to run for post processing of ILA CSV data, or Nothing
   -- if it has none.
   , targetExtraXdc :: [FilePath]
   -- ^ Extra constraints to be sourced. Will be sourced _after_ main XDC.
@@ -569,15 +574,15 @@ main = do
                 need [testExitCodePath]
                 exitCode <- read <$> readFile' testExitCodePath
                 when (isJust targetPostProcess) $ do
-                  liftIO $ doPostProcessing (fromJust targetPostProcess) ilaDataDir exitCode
+                  liftIO $ (fromJust targetPostProcess) ilaDataDir exitCode
                 unless (exitCode == ExitSuccess) $ do
                   liftIO $ exitWith exitCode
 
               when (isJust targetPostProcess) $ do
                 phony (entityName targetName <> ":post-process") $ do
                   need [testExitCodePath]
                   exitCode <- read <$> readFile' testExitCodePath
-                  liftIO $ doPostProcessing (fromJust targetPostProcess) ilaDataDir exitCode
+                  liftIO $ (fromJust targetPostProcess) ilaDataDir exitCode
 
     if null shakeTargets
       then rules