From 0edcc31d287130947641d10d2b97e83b5101529c Mon Sep 17 00:00:00 2001 From: Ryan Slawson Date: Fri, 13 Dec 2024 09:21:55 +0100 Subject: [PATCH] No more pre-processing ): --- bittide-experiments/src/Bittide/Hitl.hs | 44 +--- bittide-instances/bittide-instances.cabal | 1 + bittide-instances/data/picocom/start.sh | 4 +- .../src/Bittide/Instances/Hitl/BoardTest.hs | 9 +- .../Bittide/Instances/Hitl/DnaOverSerial.hs | 2 - .../Instances/Hitl/Driver/DnaOverSerial.hs | 59 ++++- .../Bittide/Instances/Hitl/Driver/VexRiscv.hs | 235 ++++++------------ .../Instances/Hitl/Driver/VexRiscvTcp.hs | 23 +- .../src/Bittide/Instances/Hitl/Ethernet.hs | 2 - .../src/Bittide/Instances/Hitl/FincFdec.hs | 2 - .../Bittide/Instances/Hitl/FullMeshHwCc.hs | 2 - .../Bittide/Instances/Hitl/FullMeshSwCc.hs | 4 +- .../Bittide/Instances/Hitl/HwCcTopologies.hs | 11 +- .../Instances/Hitl/LinkConfiguration.hs | 2 - .../Bittide/Instances/Hitl/SyncInSyncOut.hs | 2 - .../Instances/Hitl/TemperatureMonitor.hs | 4 - .../Bittide/Instances/Hitl/Transceivers.hs | 2 - .../Bittide/Instances/Hitl/Utils/Program.hs | 28 ++- .../src/Bittide/Instances/Hitl/VexRiscv.hs | 2 - bittide-instances/src/Project/Handle.hs | 14 +- bittide-shake/src/Clash/Shake/Vivado.hs | 113 +++------ bittide-tools/clockcontrol/plot/Main.hs | 6 +- 22 files changed, 251 insertions(+), 320 deletions(-) diff --git a/bittide-experiments/src/Bittide/Hitl.hs b/bittide-experiments/src/Bittide/Hitl.hs index 7f2462239..550fbe03a 100644 --- a/bittide-experiments/src/Bittide/Hitl.hs +++ b/bittide-experiments/src/Bittide/Hitl.hs @@ -47,7 +47,6 @@ module Bittide.Hitl ( -- * Test definition HitlTestGroup (..), HitlTestCase (..), - CasePreProcessing (..), TestStepResult (..), MayHavePostProcData (..), Done, @@ -189,7 +188,6 @@ and requires a (hypothetical) 8-bit number indicating the > , postProcData = () > } > ] -> , mPreProc = Nothing > , mPostProc = Nothing > } @@ -197,18 +195,14 @@ This must be accompanied by a @hitlVio \@NumberOfStages@ in the design. -} data HitlTestGroup where HitlTestGroup :: - (Typeable a, Typeable b, Typeable c) => + (Typeable a, Typeable b) => { topEntity :: ClashTargetName -- ^ Reference to the Design Under Test , extraXdcFiles :: [String] - , testCases :: [HitlTestCase HwTargetRef a b c] + , testCases :: [HitlTestCase HwTargetRef a b] -- ^ List of test cases - , mPreProc :: - ( VivadoHandle -> String -> FilePath -> HwTarget -> DeviceInfo -> IO (TestStepResult c) - ) - -- ^ Pre-processing step. First argument is the name of the test , mDriverProc :: - Maybe (VivadoHandle -> String -> FilePath -> [(HwTarget, DeviceInfo, c)] -> IO ExitCode) + Maybe (VivadoHandle -> String -> FilePath -> [(HwTarget, DeviceInfo)] -> IO ExitCode) -- ^ Optional function driving the test after pre-processing. , mPostProc :: Maybe (FilePath -> ExitCode -> IO (TestStepResult ())) -- ^ Optional post processing step. @@ -220,36 +214,24 @@ data HitlTestGroup where {- | A HITL test case. One HITL test group can have multiple test cases associated with it. -} -data HitlTestCase h a b c where +data HitlTestCase h a b where HitlTestCase :: - (Show h, Show a, BitPack a, Show b, Typeable h, Typeable c) => + (Show h, Show a, BitPack a, Show b, Typeable h) => { name :: String , parameters :: Map h a - , preProc :: CasePreProcessing c , postProcData :: b } -> - HitlTestCase h a b c + HitlTestCase h a b -deriving instance Show (HitlTestCase h a b c) - -data CasePreProcessing c - = InheritPreProcess - | -- | Instead of using the test-group pre-process function, use an override for - -- this specific test case. - CustomPreProcess - (VivadoHandle -> FilePath -> HwTarget -> DeviceInfo -> IO (TestStepResult c)) - -instance Show (CasePreProcessing a) where - show InheritPreProcess = "InheritPreProcess" - show (CustomPreProcess _) = "CustomPreProcess " +deriving instance Show (HitlTestCase h a b) -- | 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@, -- if that data exists. mGetPPD :: - forall h a c. - [HitlTestCase h a b c] -> + forall h a. + [HitlTestCase h a b] -> Map String (Maybe b) instance MayHavePostProcData a where @@ -292,26 +274,24 @@ to it and receives that constructur as test parameter. > testCases = testCasesFromEnum @ABC allHwTargets () -} testCasesFromEnum :: - forall a b c. + -- forall a b c. + forall a b. ( Show a , Bounded a , Enum a , BitPack a , Show b - , Show c , Typeable a , Typeable b - , Typeable c ) => [HwTargetRef] -> b -> - [HitlTestCase HwTargetRef a b c] + [HitlTestCase HwTargetRef a b] testCasesFromEnum hwTs ppd = [ HitlTestCase { 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 c7d7df199..6e504c38d 100644 --- a/bittide-instances/bittide-instances.cabal +++ b/bittide-instances/bittide-instances.cabal @@ -121,6 +121,7 @@ common common-options unix, vector, vivado-hs, + word8, library import: common-options diff --git a/bittide-instances/data/picocom/start.sh b/bittide-instances/data/picocom/start.sh index 65602d254..8ce71813e 100755 --- a/bittide-instances/data/picocom/start.sh +++ b/bittide-instances/data/picocom/start.sh @@ -20,6 +20,8 @@ PICOCOM_STDERR_LOG="${PICOCOM_STDERR_LOG:-/dev/null}" stderr_dir=$(dirname "${PICOCOM_STDERR_LOG}") mkdir -p "${stderr_dir}" -picocom --baud 921600 --imap lfcrlf --omap lfcrlf $@ \ +PICOCOM_BAUD="${PICOCOM_BAUD:-921600}" + +picocom --baud "${PICOCOM_BAUD}" --imap lfcrlf --omap lfcrlf $@ \ > >(tee "${PICOCOM_STDOUT_LOG}") \ 2> >(tee "${PICOCOM_STDERR_LOG}" >&2) diff --git a/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs b/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs index 2afe30775..3a45f0db8 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/BoardTest.hs @@ -22,13 +22,11 @@ import Bittide.Instances.Hitl.Post.BoardTestExtended import Bittide.Instances.Hitl.Post.PostProcess import Bittide.Hitl ( - CasePreProcessing (..), HitlTestCase (..), HitlTestGroup (..), TestStepResult (..), hitlVio, hitlVioBool, - noPreProcess, paramForHwTargets, testCasesFromEnum, ) @@ -189,11 +187,11 @@ testSimple = { name = "Simple" , parameters = (paramForHwTargets allHwTargets ()) , postProcData = () - , preProc = InheritPreProcess + -- , preProc = InheritPreProcess } ] - , mPreProc = noPreProcess - , mDriverProc = Nothing + , -- , mPreProc = noPreProcess + mDriverProc = Nothing , mPostProc = Nothing } @@ -204,7 +202,6 @@ testExtended = , extraXdcFiles = [] , externalHdl = [] , testCases = testCasesFromEnum @Test allHwTargets () - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Just postBoardTestExtendedFunc } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/DnaOverSerial.hs b/bittide-instances/src/Bittide/Instances/Hitl/DnaOverSerial.hs index 8f84efd68..78c969a35 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/DnaOverSerial.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/DnaOverSerial.hs @@ -97,10 +97,8 @@ tests = { name = "DnaOverSerial" , parameters = paramForHwTargets allHwTargets () , postProcData = () - , preProc = InheritPreProcess } ] - , mPreProc = dnaOverSerialPreProcess , mDriverProc = Just dnaOverSerialDriver , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Driver/DnaOverSerial.hs b/bittide-instances/src/Bittide/Instances/Hitl/Driver/DnaOverSerial.hs index 99a12feb1..9ac121faf 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Driver/DnaOverSerial.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Driver/DnaOverSerial.hs @@ -16,6 +16,8 @@ import Bittide.Instances.Hitl.Utils.Program import Bittide.Instances.Hitl.Utils.Vivado import Control.Exception import Control.Monad.Extra +import Data.Char (isHexDigit) +import Data.Either (partitionEithers) import qualified Data.List as L import Data.Maybe import Numeric @@ -49,7 +51,12 @@ dnaOverSerialPreProcess _v _name _ilaPath hwT deviceInfo = do stderrLog = hitlDir "picocom-stderr." <> show targetIndex <> ".log" putStrLn $ "logging stdout to `" <> stdoutLog <> "`" putStrLn $ "logging stderr to `" <> stderrLog <> "`" - (pico, picoClean) <- startPicocomWithLogging deviceInfo.serial stdoutLog stderrLog + (pico, picoClean) <- + startPicocomWithLoggingAndEnv + deviceInfo.serial + stdoutLog + stderrLog + [("PICOCOM_BAUD", "9600")] hSetBuffering pico.stdinHandle LineBuffering hSetBuffering pico.stdoutHandle LineBuffering @@ -63,14 +70,30 @@ dnaOverSerialDriver :: VivadoHandle -> String -> FilePath -> - [(HwTarget, DeviceInfo, (ProcessStdIoHandles, IO ()))] -> + [(HwTarget, DeviceInfo)] -> IO ExitCode dnaOverSerialDriver v _name ilaPath targets = do - flip finally (forM targets $ \(_, _, (_, cleanup)) -> cleanup) $ do + preProcessResults <- forM targets $ \(hwT, dI) -> do + dnaOverSerialPreProcess v _name ilaPath hwT dI >>= \case + TestStepSuccess out -> pure $ Right out + TestStepFailure reason -> pure $ Left reason + + putStrLn "Attempted to open Picocom for all target devices" + + let (preProcessFails, preProcessPasses) = partitionEithers preProcessResults + + unless (null preProcessFails) $ do + let failReason = "Some preprocess steps failed. reasons:\n - " <> L.intercalate "\n - " preProcessFails + forM_ preProcessPasses snd + assertFailure failReason + + putStrLn "No failures for Picocom opening" + + flip finally (forM preProcessPasses snd) $ do putStrLn "Starting all targets to read DNA values" -- start all targets - forM_ targets $ \(hwT, _, _) -> do + forM_ targets $ \(hwT, _) -> do openHwT v hwT execCmd_ v "set_property" ["PROBES.FILE", embrace ilaPath, "[current_hw_device]"] refresh_hw_device v [] @@ -80,16 +103,17 @@ dnaOverSerialDriver v _name ilaPath targets = do putStrLn "Expecting specific DNAs for all serial ports" putStrLn "Serial ports:" - mapM_ putStrLn [d.serial | (_, d, _) <- targets] + mapM_ putStrLn [d.serial | (_, d) <- targets] - results <- forM targets $ \(_, d, (picoCom, picoClean)) -> do + results <- forM (L.zip targets preProcessPasses) $ \((_, d), (picoCom, picoClean)) -> do + putStrLn $ "Waiting for output on port: " <> d.serial res <- checkDna d picoCom picoClean - pure $ res + pure res print results - if (and results) - then pure $ ExitSuccess + if and results + then pure ExitSuccess else do assertFailure "Not all FPGAs transmitted the expected DNA" pure $ ExitFailure 2 @@ -101,8 +125,12 @@ dnaOverSerialDriver v _name ilaPath targets = do when (isNothing terminalReadyResult) $ do assertFailure "Timeout waiting for \"Terminal ready\"" - _ <- hGetLine pico.stdoutHandle -- Discard a potentially incomplete line - receivedDna <- hGetLine pico.stdoutHandle + putStrLn "Terminal is ready!" + + receivedDna0 <- timeout 10_000_000 $ findDna pico "" + receivedDna <- case receivedDna0 of + Just rDna -> return rDna + Nothing -> assertFailure "Timeout waiting for DNA" let expected = showHex d.dna "" differences = L.zipWith (\e a -> if e == a then ' ' else '^') expected receivedDna @@ -112,3 +140,12 @@ dnaOverSerialDriver v _name ilaPath targets = do putStrLn $ "Received DNA: " <> receivedDna putStrLn $ "Differences: " <> differences pure match + findDna :: ProcessStdIoHandles -> String -> IO String + findDna pico prev = do + nC <- hGetChar pico.stdoutHandle + if isHexDigit nC + then findDna pico (prev <> [nC]) + else + if null prev + then findDna pico prev + else return prev diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscv.hs b/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscv.hs index 5c7b55438..38491542c 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscv.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscv.hs @@ -5,7 +5,6 @@ {-# LANGUAGE NumericUnderscores #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fplugin=Protocols.Plugin #-} -- {-# OPTIONS -fplugin-opt=Protocols.Plugin:debug #-} @@ -27,15 +26,16 @@ import Bittide.Instances.Hitl.Utils.Program import Bittide.Instances.Hitl.Utils.Vivado import Control.Concurrent (threadDelay) -import Control.Exception (SomeException, catch, displayException) -import Control.Monad (forM) +import Control.Exception (SomeException, displayException, handle) +import Control.Monad (forM, forM_, unless) +import Data.Either (partitionEithers) import qualified Data.List as L -import Data.Maybe (fromJust, fromMaybe) +import Data.Maybe (fromMaybe) import System.Exit import System.FilePath import System.IO -import System.Process import System.Timeout (timeout) +import Test.Tasty.HUnit (assertFailure) preProcessFunc :: VivadoHandle -> @@ -76,31 +76,12 @@ preProcessFunc v _name ilaPath hwT deviceInfo = do putStrLn $ "logging stderr to `" <> stderrLog <> "`" putStrLn "Starting Picocom..." - -- (pico, picoClean) <- startPicocomWithLogging deviceInfo.serial stdoutLog stderrLog - - (pico, picoClean) <- do - let picoProc = - ( proc - "picocom" - ["--baud", "9600", "--imap", "lfcrlf", "--omap", "lfcrlf", deviceInfo.serial] - ) - { std_out = CreatePipe - , std_in = CreatePipe - , std_err = CreatePipe - , new_session = True -- Seems to be required for picocom to work - } - picoHandles@(picoStdin, picoStdout, picoStderr, _picoPh) <- - createProcess picoProc - - let - picoHandles' = - ProcessStdIoHandles - { stdinHandle = fromJust picoStdin - , stdoutHandle = fromJust picoStdout - , stderrHandle = fromJust picoStderr - } - - pure (picoHandles', cleanupProcess picoHandles) + (pico, picoClean) <- + startPicocomWithLoggingAndEnv + deviceInfo.serial + stdoutLog + stderrLog + [("PICOCOM_BAUD", "9600")] hSetBuffering pico.stdinHandle LineBuffering hSetBuffering pico.stdoutHandle LineBuffering @@ -151,16 +132,24 @@ driverFunc :: VivadoHandle -> String -> FilePath -> - [ ( HwTarget - , DeviceInfo - , () - ) - ] -> + [(HwTarget, DeviceInfo)] -> IO ExitCode driverFunc v _name ilaPath targets = do putStrLn $ "Running Driver function for targets " - <> show ((\(_, info, _) -> info.deviceId) <$> targets) + <> show ((\(_, info) -> info.deviceId) <$> targets) + + preProcessResults <- forM targets $ \(hwT, dI) -> do + preProcessFunc v _name ilaPath hwT dI >>= \case + TestStepSuccess out -> pure $ Right out + TestStepFailure reason -> pure $ Left reason + + let (preProcessFails, preProcessPasses) = partitionEithers preProcessResults + + unless (null preProcessFails) $ do + let failReason = "some preprocess steps failed. reasons:\n - " <> L.intercalate "\n - " preProcessFails + forM_ preProcessPasses (\(_, _, _, cleanup) -> cleanup) + assertFailure failReason let catchError :: DeviceInfo -> SomeException -> IO ExitCode @@ -168,126 +157,66 @@ driverFunc v _name ilaPath targets = do putStrLn $ "Test Failed on device " <> d.deviceId <> " with: " <> displayException ex pure $ ExitFailure 2 - exitCodes <- forM targets $ \(hwT, d, ()) -> flip catch (catchError d) $ do - putStrLn $ "Running driver for " <> d.deviceId - - - openHwT v hwT - execCmd_ v "set_property" ["PROBES.FILE", embrace ilaPath, "[current_hw_device]"] - refresh_hw_device v [] - - -- even though this is just pre-process step, the CPU is reset until - -- the test_start signal is asserted and cannot be accessed via GDB otherwise - execCmd_ v "set_property" ["OUTPUT_VALUE", "1", getProbeTestStartTcl] + exitCodes <- forM (L.zip targets preProcessPasses) $ \((_, d), (_, pico, gdb, cleanup)) -> handle (catchError d) $ do + -- break test + let + -- Create function to log the output of the processes + loggingSequence = do + threadDelay 1_000_000 -- Wait 1 second for data loggers to catch up + putStrLn "Picocom stdout" + picocomOut <- readRemainingChars pico.stdoutHandle + + putStrLn picocomOut + + putStrLn "Picocom StdErr" + readRemainingChars pico.stderrHandle >>= putStrLn + + tryWithTimeout :: String -> Int -> IO a -> IO a + tryWithTimeout actionName dur action = do + result <- timeout dur action + case result of + Nothing -> do + loggingSequence + error $ "Timeout while performing action: " <> actionName + Just r -> pure r + putStrLn "Testing whether breakpoints work" + + runGdbCommands + gdb.stdinHandle + [ "break hello::test_success" + , "jump _start" + , gdbEcho "breakpoint reached" + ] + + tryWithTimeout "Waiting for \"breakpoint reached\"" 10_000_000 + $ waitForLine gdb.stdoutHandle "breakpoint reached" + + runGdbCommands + gdb.stdinHandle + [ "disable 1" + , gdbEcho "continuing" + , "continue" + ] + + tryWithTimeout "Waiting for \"continuing\"" 10_000_000 + $ waitForLine gdb.stdoutHandle "continuing" + + -- This is the last thing that will print when the FPGA has been programmed + -- and starts entereing UART-echo mode. + tryWithTimeout "Waiting for \"Going in echo mode!\"" 10_000_000 + $ waitForLine pico.stdoutHandle "Going in echo mode!" + + -- Test UART echo + hPutStrLn pico.stdinHandle "Hello, UART!" + tryWithTimeout "Waiting for \"Hello, UART!!\"" 10_000_000 + $ waitForLine pico.stdoutHandle "Hello, UART!" + + execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] commit_hw_vio v ["[get_hw_vios]"] - let targetId = idFromHwT hwT - let targetIndex = fromMaybe 9 $ L.findIndex (\di -> di.deviceId == targetId) demoRigInfo - -- since we're running one test after another we don't need a different port - let gdbPort = 3333 -- + targetIndex - - withOpenOcd d.usbAdapterLocation gdbPort $ \ocd -> do - - -- make sure OpenOCD is started properly - - hSetBuffering ocd.stderrHandle LineBuffering - expectLine ocd.stderrHandle openOcdWaitForHalt - - -- make sure PicoCom is started properly - - projectDir <- findParentContaining "cabal.project" - let - hitlDir = projectDir "_build" "hitl" - stdoutLog = hitlDir "picocom-stdout." <> show targetIndex <> ".log" - stderrLog = hitlDir "picocom-stderr." <> show targetIndex <> ".log" - putStrLn $ "logging stdout to `" <> stdoutLog <> "`" - putStrLn $ "logging stderr to `" <> stderrLog <> "`" - - putStrLn "Starting Picocom..." - withPicocomWithLogging d.serial stdoutLog stderrLog $ \pico -> do - - hSetBuffering pico.stdinHandle LineBuffering - hSetBuffering pico.stdoutHandle LineBuffering - - let - -- Create function to log the output of the processes - loggingSequence = do - threadDelay 1_000_000 -- Wait 1 second for data loggers to catch up - putStrLn "Picocom stdout" - picocomOut <- readRemainingChars pico.stdoutHandle - - putStrLn picocomOut - - putStrLn "Picocom StdErr" - readRemainingChars pico.stderrHandle >>= putStrLn - - tryWithTimeout :: String -> Int -> IO a -> IO a - tryWithTimeout actionName dur action = do - result <- timeout dur action - case result of - Nothing -> do - loggingSequence - error $ "Timeout while performing action: " <> actionName - Just r -> pure r - - tryWithTimeout "Waiting for \"Terminal ready\"" 10_000_000 - $ waitForLine pico.stdoutHandle "Terminal ready" - - -- program the FPGA - withGdb $ \gdb -> do - - hSetBuffering gdb.stdinHandle LineBuffering - - runGdbCommands - gdb.stdinHandle - [ "file \"./_build/cargo/firmware-binaries/riscv32imc-unknown-none-elf/debug/hello\"" - , "target extended-remote :" <> show gdbPort - , "load" - , gdbEcho "load done" - ] - - tryWithTimeout "Waiting for \"load dome\"" 120_000_000 - $ waitForLine gdb.stdoutHandle "load done" - - - -- break test - do - putStrLn "Testing whether breakpoints work" - - runGdbCommands - gdb.stdinHandle - [ "break hello::test_success" - , "jump _start" - , gdbEcho "breakpoint reached" - ] - - tryWithTimeout "Waiting for \"breakpoint reached\"" 10_000_000 - $ waitForLine gdb.stdoutHandle "breakpoint reached" - - runGdbCommands - gdb.stdinHandle - [ "disable 1" - , gdbEcho "continuing" - , "continue" - ] - - tryWithTimeout "Waiting for \"continuing\"" 10_000_000 - $ waitForLine gdb.stdoutHandle "continuing" - - -- This is the last thing that will print when the FPGA has been programmed - -- and starts entereing UART-echo mode. - tryWithTimeout "Waiting for \"Going in echo mode!\"" 10_000_000 - $ waitForLine pico.stdoutHandle "Going in echo mode!" - - -- Test UART echo - hPutStrLn pico.stdinHandle "Hello, UART!" - tryWithTimeout "Waiting for \"Hello, UART!!\"" 10_000_000 - $ waitForLine pico.stdoutHandle "Hello, UART!" - - execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] - commit_hw_vio v ["[get_hw_vios]"] + cleanup - pure $ ExitSuccess + pure ExitSuccess let exitCode = L.foldl diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscvTcp.hs b/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscvTcp.hs index 7bdbee464..70daff4b5 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscvTcp.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Driver/VexRiscvTcp.hs @@ -112,7 +112,12 @@ preProcessFunc v _name ilaPath hwT deviceInfo = do putStrLn $ "logging stderr to `" <> stderrLog <> "`" putStrLn "Starting Picocom..." - (pico, picoClean) <- startPicocomWithLogging deviceInfo.serial stdoutLog stderrLog + (pico, picoClean) <- + startPicocomWithLoggingAndEnv + deviceInfo.serial + stdoutLog + stderrLog + [("PICOCOM_BAUD", "9600")] hSetBuffering pico.stdinHandle LineBuffering hSetBuffering pico.stdoutHandle LineBuffering @@ -178,13 +183,15 @@ driverFunc :: VivadoHandle -> String -> FilePath -> - [ ( HwTarget - , DeviceInfo - , (ProcessStdIoHandles, ProcessStdIoHandles, ProcessStdIoHandles, IO ()) - ) - ] -> + [(HwTarget, DeviceInfo)] -> IO ExitCode -driverFunc v _name ilaPath [(hwT, _, (_ocd, pico, _gdb, cleanupFn))] = do +driverFunc v _name ilaPath [(hwT, dI)] = do + preProcessResult <- preProcessFunc v _name ilaPath hwT dI + + (_ocd, pico, _gdb, cleanupFn) <- case preProcessResult of + TestStepSuccess out -> pure out + TestStepFailure reason -> assertFailure $ "test failed. reason: " <> reason + openHwT v hwT execCmd_ v "set_property" ["PROBES.FILE", embrace ilaPath, "[current_hw_device]"] refresh_hw_device v [] @@ -238,7 +245,7 @@ driverFunc v _name ilaPath [(hwT, _, (_ocd, pico, _gdb, cleanupFn))] = do cleanupFn - pure $ ExitSuccess + pure ExitSuccess driverFunc _v _name _ilaPath _ = error "Ethernet/VexRiscvTcp driver func should only run with one hardware target" {- | Test that the `Bittide.Instances.Hitl.Ethernet:vexRiscvTcpTest` design programmed diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs b/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs index a37bbfd28..ba0dee994 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Ethernet.hs @@ -89,10 +89,8 @@ tests = { name = "VexRiscvTcp" , parameters = paramForSingleHwTarget (HwTargetByIndex 7) () , postProcData = () - , preProc = InheritPreProcess } ] - , mPreProc = preProcessFunc , mDriverProc = Just driverFunc , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs index cf1b2b541..afd5d8d24 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FincFdec.hs @@ -25,7 +25,6 @@ import Bittide.Hitl ( HitlTestGroup (..), HwTargetRef (HwTargetByIndex), hitlVio, - noPreProcess, testCasesFromEnum, ) import Bittide.Instances.Domains @@ -223,7 +222,6 @@ tests = , extraXdcFiles = [] , externalHdl = [] , testCases = testCasesFromEnum @Test [HwTargetByIndex 7] () - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs index 82c7774ca..10ceeb213 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshHwCc.hs @@ -540,10 +540,8 @@ mkTest topEntity = , clockOffsets = Nothing , startupDelays = toList $ repeat @FpgaCount 0 } - , preProc = InheritPreProcess } ] - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs index 4887f563a..408359897 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/FullMeshSwCc.hs @@ -58,7 +58,7 @@ import Bittide.Transceiver (transceiverPrbsN) import Bittide.Instances.Hitl.HwCcTopologies (cSigMap, commonSpiConfig, csDupe) import Bittide.Instances.Hitl.IlaPlot -import Bittide.Instances.Hitl.Post.FullMeshSwCc (postProcess, preProcess) +import Bittide.Instances.Hitl.Post.FullMeshSwCc (postProcess) import Bittide.Instances.Hitl.Setup hiding (FpgaCount, LinkCount) import Clash.Annotations.TH (makeTopEntity) @@ -713,11 +713,9 @@ tests = , clockOffsets = Nothing , startupDelays = toList $ repeat @FpgaCount 0 } - , preProc = InheritPreProcess } | n <- [0 .. testsToRun - 1] ] - , mPreProc = preProcess , mDriverProc = Nothing , mPostProc = Just postProcess } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs index be852f34d..5896b5eb4 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/HwCcTopologies.hs @@ -854,7 +854,8 @@ tests = testGroup calibrateClockOffsets = calibrateCC False validateClockOffsetCalibration = calibrateCC True - calibrateCC :: Bool -> HitlTestCase HwTargetRef TestConfig CcConf () + -- calibrateCC :: Bool -> HitlTestCase HwTargetRef TestConfig CcConf () + calibrateCC :: Bool -> HitlTestCase HwTargetRef TestConfig CcConf calibrateCC validate = HitlTestCase { name = (if validate then "zzz_validate" else "0_calibrate") <> "_clock_offsets" @@ -876,7 +877,7 @@ tests = testGroup , clockOffsets = Nothing , startupDelays = toList $ repeat @FpgaCount 0 } - , preProc = InheritPreProcess + -- , preProc = InheritPreProcess } -- tests the given topology @@ -886,7 +887,8 @@ tests = testGroup Maybe (Vec n PartsPer) -> Vec n StartupDelay -> Topology n -> - HitlTestCase HwTargetRef TestConfig CcConf () + -- HitlTestCase HwTargetRef TestConfig CcConf () + HitlTestCase HwTargetRef TestConfig CcConf tt clockShifts startDelays t = HitlTestCase { name = topologyName t @@ -910,7 +912,7 @@ tests = testGroup , clockOffsets = toList <$> clockShifts , startupDelays = fromIntegral <$> toList startDelays } - , preProc = InheritPreProcess + -- , preProc = InheritPreProcess } maybeVecToVecMaybe :: forall n a. (KnownNat n) => Maybe (Vec n a) -> Vec n (Maybe a) @@ -957,7 +959,6 @@ tests = testGroup -- make sure the clock offsets detected during calibration is still the same , validateClockOffsetCalibration ] - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs b/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs index 8b115170c..76583aa36 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/LinkConfiguration.hs @@ -285,10 +285,8 @@ tests = | i <- [0 ..] :: [Index FpgaCount] ] , postProcData = () - , preProc = InheritPreProcess } ] - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs b/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs index fcf16b711..49d31f71e 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/SyncInSyncOut.hs @@ -168,10 +168,8 @@ tests = { name = "SyncInSyncOut" , parameters = paramForHwTargets allHwTargets () , postProcData = () - , preProc = InheritPreProcess } ] - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs b/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs index b1b765008..fcf0bc813 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/TemperatureMonitor.hs @@ -18,11 +18,9 @@ import Clash.Xilinx.ClockGen (clockWizardDifferential) import Bittide.Arithmetic.Time (trueFor) import Bittide.Hitl ( - CasePreProcessing (..), HitlTestCase (..), HitlTestGroup (..), hitlVioBool, - noPreProcess, paramForHwTargets, ) import Bittide.Instances.Hitl.Setup (allHwTargets) @@ -113,10 +111,8 @@ tests = { name = "TemperatureMonitor" , parameters = paramForHwTargets allHwTargets () , postProcData = () - , preProc = InheritPreProcess } ] - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs b/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs index 0b0ef4fd6..1bb524beb 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Transceivers.hs @@ -233,7 +233,6 @@ tests = , externalHdl = [] , extraXdcFiles = [] , testCases = iters - , mPreProc = noPreProcess , mDriverProc = Nothing , mPostProc = Nothing } @@ -247,7 +246,6 @@ tests = , parameters = Map.fromList (L.zip (HwTargetByIndex . fromIntegral <$> fpgaIndices) fpgaIndices) , postProcData = () - , preProc = InheritPreProcess } | nm <- iterNames ] diff --git a/bittide-instances/src/Bittide/Instances/Hitl/Utils/Program.hs b/bittide-instances/src/Bittide/Instances/Hitl/Utils/Program.hs index 2e13571e0..8325ca87c 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/Utils/Program.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/Utils/Program.hs @@ -113,7 +113,6 @@ startPicocom devPath = do pure (picoHandles', cleanupProcess picoHandles) - withPicocomWithLogging :: FilePath -> FilePath -> @@ -124,9 +123,29 @@ withPicocomWithLogging devPath stdoutPath stderrPath action = do (pico, clean) <- startPicocomWithLogging devPath stdoutPath stderrPath finally (action pico) clean +withPicocomWithLoggingAndEnv :: + FilePath -> + FilePath -> + FilePath -> + [(String, String)] -> + (ProcessStdIoHandles -> IO a) -> + IO a +withPicocomWithLoggingAndEnv devPath stdoutPath stderrPath extraEnv action = do + (pico, clean) <- startPicocomWithLoggingAndEnv devPath stdoutPath stderrPath extraEnv + finally (action pico) clean + startPicocomWithLogging :: FilePath -> FilePath -> FilePath -> IO (ProcessStdIoHandles, IO ()) -startPicocomWithLogging devPath stdoutPath stderrPath = do +startPicocomWithLogging devPath stdoutPath stderrPath = + startPicocomWithLoggingAndEnv devPath stdoutPath stderrPath [] + +startPicocomWithLoggingAndEnv :: + FilePath -> + FilePath -> + FilePath -> + [(String, String)] -> + IO (ProcessStdIoHandles, IO ()) +startPicocomWithLoggingAndEnv devPath stdoutPath stderrPath extraEnv = do startPicocomPath <- getPicocomStartPath currentEnv <- getEnvironment @@ -139,7 +158,10 @@ startPicocomWithLogging devPath stdoutPath stderrPath = do , new_session = True , env = Just - (currentEnv <> [("PICOCOM_STDOUT_LOG", stdoutPath), ("PICOCOM_STDERR_LOG", stderrPath)]) + ( currentEnv + <> extraEnv + <> [("PICOCOM_STDOUT_LOG", stdoutPath), ("PICOCOM_STDERR_LOG", stderrPath)] + ) } picoHandles@(picoStdin, picoStdout, picoStderr, _picoPh) <- diff --git a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs index e4a648a50..9fccc15af 100644 --- a/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs +++ b/bittide-instances/src/Bittide/Instances/Hitl/VexRiscv.hs @@ -164,10 +164,8 @@ tests = , parameters = paramForHwTargets [HwTargetByIndex 1, HwTargetByIndex 2] () , postProcData = () - , preProc = InheritPreProcess } ] - , mPreProc = noPreProcess -- preProcessFunc , mDriverProc = Just driverFunc , mPostProc = Nothing } diff --git a/bittide-instances/src/Project/Handle.hs b/bittide-instances/src/Project/Handle.hs index 4c0fcd1e6..591b0edd4 100644 --- a/bittide-instances/src/Project/Handle.hs +++ b/bittide-instances/src/Project/Handle.hs @@ -4,11 +4,15 @@ module Project.Handle where -import Prelude +import Prelude hiding (filter) +import Data.ByteString (filter, unpack) +import Data.ByteString.Char8 (hGetLine) +import Data.ByteString.Internal (w2c) import Data.List.Extra (trimEnd) +import Data.Word8 (isControl, isAscii) import Debug.Trace -import System.IO +import System.IO (Handle, hGetChar, hReady) import Test.Tasty.HUnit @@ -25,9 +29,11 @@ expectLine :: (HasCallStack) => Handle -> (String -> Filter) -> Assertion expectLine = expectLine' "" where expectLine' s0 h f = do - line <- hGetLine h + byteLine0 <- hGetLine h let - trimmed = filter (/= '\NUL') (trimEnd line) + byteLine1 = filter (\c -> isAscii c && not (isControl c)) byteLine0 + line = w2c <$> unpack byteLine1 + trimmed = trimEnd line s1 = s0 <> "\n" <> line cont = expectLine' s1 h f if null trimmed diff --git a/bittide-shake/src/Clash/Shake/Vivado.hs b/bittide-shake/src/Clash/Shake/Vivado.hs index e08cc9cf3..3a50ee89a 100644 --- a/bittide-shake/src/Clash/Shake/Vivado.hs +++ b/bittide-shake/src/Clash/Shake/Vivado.hs @@ -25,6 +25,7 @@ module Clash.Shake.Vivado ( runPlaceAndRoute, runBitstreamGen, runProbesFileGen, + pollTestDone, programBitstream, runHitlTest, meetsTiming, @@ -48,7 +49,7 @@ import Control.Concurrent.MVar (MVar, modifyMVar, newMVar) import Control.Exception (try) import Control.Monad.Extra (andM, forM, forM_, orM, unless, when) import Data.Containers.ListUtils (nubOrd) -import Data.Either (lefts, partitionEithers, rights) +import Data.Either (lefts, rights) import Data.List (isInfixOf, isSuffixOf, sort, sortOn, (\\)) import Data.List.Extra (anySame, split, (!?)) import Data.Map.Strict (fromList, keys, mapKeys, toAscList) @@ -58,9 +59,9 @@ import Data.Set (Set) import qualified Data.Set as Set import Data.String.Interpolate (i, __i) import Data.Text (unpack) -import System.Clock (Clock (Monotonic), diffTimeSpec, getTime, toNanoSecs) +import System.Clock (Clock (Monotonic), TimeSpec, diffTimeSpec, getTime, toNanoSecs) import System.Directory (createDirectoryIfMissing) -import System.Exit (ExitCode (..), exitFailure) +import System.Exit (ExitCode (..)) import System.FilePath (dropFileName, ()) import Text.Read (readMaybe) import Vivado (TclException (..), VivadoHandle, execPrint_, with) @@ -661,37 +662,14 @@ verifyHwIlas v = do the probe_test_done probe. Returns whether the test case was successful. -} waitTestCaseEnd :: - VivadoHandle -> HitlTestCase (HwTarget, DeviceInfo) a b c -> FilePath -> IO ExitCode + VivadoHandle -> HitlTestCase (HwTarget, DeviceInfo) a b -> FilePath -> IO ExitCode waitTestCaseEnd v HitlTestCase{..} probesFilePath = do startTime <- getTime Monotonic let calcTimeSpentMs = (`div` 1000000) . toNanoSecs . diffTimeSpec startTime <$> getTime Monotonic exitCodes <- forM (keys parameters) $ \(hwT, _) -> do openHwT v hwT execCmd_ v "set_property" ["PROBES.FILE", embrace probesFilePath, "[current_hw_device]"] - let - pollTestDone :: IO ExitCode - pollTestDone = do - refresh_hw_device v ["-quiet"] - timeSpentMs <- calcTimeSpentMs - done <- execCmd v "get_property" ["INPUT_VALUE", getProbeTestDoneTcl] - success <- execCmd v "get_property" ["INPUT_VALUE", getProbeTestSuccessTcl] - case (done, success, timeSpentMs >= testTimeoutMs) of - ("1", "1", _) -> do - pure ExitSuccess - ("1", _, _) -> do - putStrLn $ "HITL test case failure for hardware target " <> prettyShow hwT - pure (ExitFailure 2) - (_, _, True) -> do - putStrLn $ - "HITL test case timeout (≥" - <> show testTimeoutMs - <> "ms) for hardware target " - <> prettyShow hwT - pure (ExitFailure 3) - _ -> do - threadDelay 1000 -- In μs - pollTestDone - pollTestDone + pollTestDone startTime testTimeoutMs v hwT -- Print summary of test case timeSpentMs <- calcTimeSpentMs @@ -712,6 +690,31 @@ waitTestCaseEnd v HitlTestCase{..} probesFilePath = do -- TODO: Allow the user to specify the timeout for a test. testTimeoutMs = 60000 :: Integer +pollTestDone :: TimeSpec -> Integer -> VivadoHandle -> HwTarget -> IO ExitCode +pollTestDone startTime testTimeoutMs v hwT = do + refresh_hw_device v ["-quiet"] + timeSpentMs <- calcTimeSpentMs + done <- execCmd v "get_property" ["INPUT_VALUE", getProbeTestDoneTcl] + success <- execCmd v "get_property" ["INPUT_VALUE", getProbeTestSuccessTcl] + case (done, success, timeSpentMs >= testTimeoutMs) of + ("1", "1", _) -> do + pure ExitSuccess + ("1", _, _) -> do + putStrLn $ "HITL test case failure for hardware target " <> prettyShow hwT + pure (ExitFailure 2) + (_, _, True) -> do + putStrLn $ + "HITL test case timeout (≥" + <> show testTimeoutMs + <> "ms) for hardware target " + <> prettyShow hwT + pure (ExitFailure 3) + _ -> do + threadDelay 1000 -- In μs + pollTestDone startTime testTimeoutMs v hwT + where + calcTimeSpentMs = (`div` 1000000) . toNanoSecs . diffTimeSpec startTime <$> getTime Monotonic + runHitlTest :: -- | The HITL test group to execute HitlTestGroup -> @@ -722,7 +725,7 @@ runHitlTest :: -- | Filepath the the ILA data dump directory FilePath -> IO ExitCode -runHitlTest test@HitlTestGroup{topEntity, testCases, mPreProc, mDriverProc} url probesFilePath ilaDataDir = do +runHitlTest test@HitlTestGroup{topEntity, testCases, mDriverProc} url probesFilePath ilaDataDir = do putStrLn $ "Starting HITL test for FPGA design '" <> show topEntity @@ -766,7 +769,7 @@ runHitlTest test@HitlTestGroup{topEntity, testCases, mPreProc, mDriverProc} url lookupDeviceInfo key = deviceInfoFromHwTRef key exitCode <- - runHitlTestCase v resolvedTestCase mPreProc mDriverProc probesFilePath ilaDataDir + runHitlTestCase v resolvedTestCase mDriverProc probesFilePath ilaDataDir pure (name, exitCode) let failedTestCaseNames = fst <$> filter ((/= ExitSuccess) . snd) testResults @@ -790,21 +793,19 @@ runHitlTest test@HitlTestGroup{topEntity, testCases, mPreProc, mDriverProc} url -- | Runs one test case of a HITL test group runHitlTestCase :: - forall a b c. + forall a b. -- | Handle to a Vivado object that is to execute the Tcl VivadoHandle -> -- | The HITL test case to run - HitlTestCase (HwTarget, DeviceInfo) a b c -> - -- | Pre-process function for the test group - (VivadoHandle -> String -> FilePath -> HwTarget -> DeviceInfo -> IO (TestStepResult c)) -> + HitlTestCase (HwTarget, DeviceInfo) a b -> -- | Driver function - Maybe (VivadoHandle -> String -> FilePath -> [(HwTarget, DeviceInfo, c)] -> IO ExitCode) -> + Maybe (VivadoHandle -> String -> FilePath -> [(HwTarget, DeviceInfo)] -> IO ExitCode) -> -- | Path to the generated probes file FilePath -> -- | Filepath the the ILA data dump directory FilePath -> IO ExitCode -runHitlTestCase v testCase@HitlTestCase{name, parameters, preProc} preProcessFunc driverFunc probesFilePath ilaDataDir = do +runHitlTestCase v testCase@HitlTestCase{name, parameters} driverFunc probesFilePath ilaDataDir = do if null parameters then do putStrLn @@ -871,32 +872,7 @@ runHitlTestCase v testCase@HitlTestCase{name, parameters, preProc} preProcessFun execCmd_ v "set_property" ["OUTPUT_VALUE", "0", getProbeTestStartTcl] commit_hw_vio v ["[get_hw_vios]"] - -- run pre-processing - testRunData <- case preProc of - InheritPreProcess -> do - putStrLn $ - "Running test-group pre-process function for " - <> name - <> " ('" - <> prettyShow hwT - <> "')" - preProcessFunc v name probesFilePath hwT deviceInfo - CustomPreProcess f -> do - putStrLn $ - "Running case pre-process function for " - <> name - <> " ('" - <> prettyShow hwT - <> "')" - f v probesFilePath hwT deviceInfo - - case testRunData of - TestStepFailure msg -> do - putStrLn $ - "pre-process step failed: " <> msg - pure $ Left (hwT, msg) - TestStepSuccess val -> do - pure $ Right (hwT, deviceInfo, val) + return (hwT, deviceInfo) -- Assert HitlVio start probe -- execCmd_ v "set_property" ["OUTPUT_VALUE", "1", getProbeTestStartTcl] @@ -905,16 +881,14 @@ runHitlTestCase v testCase@HitlTestCase{name, parameters, preProc} preProcessFun -- pure testRunData - let (failedTests, validTests) = partitionEithers testData - - testCaseExitCode0 <- case driverFunc of + testCaseExitCode <- case driverFunc of Just fn -> do putStrLn $ "Running custom driver function for test " <> name - fn v name probesFilePath validTests + fn v name probesFilePath testData Nothing -> do putStrLn $ "Running default driver function for test " <> name - forM_ validTests $ \(hwT, _deviceInfo, _testData) -> do + forM_ testData $ \(hwT, _deviceInfo) -> do -- Assert HitlVio start probe openHwT v hwT execCmd_ v "set_property" ["PROBES.FILE", embrace probesFilePath, "[current_hw_device]"] @@ -927,11 +901,6 @@ runHitlTestCase v testCase@HitlTestCase{name, parameters, preProc} preProcessFun putStrLn $ "Waiting for test case '" <> name <> "' to end..." waitTestCaseEnd v testCase probesFilePath - testCaseExitCode <- - if null failedTests - then pure testCaseExitCode0 - else exitFailure - putStrLn "Saving captured ILA data (if relevant)..." forM_ (keys parameters) $ \(hwT, _) -> do openHwT v hwT diff --git a/bittide-tools/clockcontrol/plot/Main.hs b/bittide-tools/clockcontrol/plot/Main.hs index 75302d07d..a7bb25c29 100644 --- a/bittide-tools/clockcontrol/plot/Main.hs +++ b/bittide-tools/clockcontrol/plot/Main.hs @@ -487,8 +487,10 @@ knownTestsWithCcConf = Map.fromList (mapMaybe go hitlTests) justOrDie _ (Just x) = Just x justOrDie k Nothing = error $ "No CcConf for " <> show k - go HitlTestGroup{topEntity, testCases = iters :: [HitlTestCase HwTargetRef q r c]} = - case cast @[HitlTestCase HwTargetRef q r c] @[HitlTestCase HwTargetRef q CcConf c] iters of + -- go HitlTestGroup{topEntity, testCases = iters :: [HitlTestCase HwTargetRef q r c]} = + go HitlTestGroup{topEntity, testCases = iters :: [HitlTestCase HwTargetRef q r]} = + -- case cast @[HitlTestCase HwTargetRef q r c] @[HitlTestCase HwTargetRef q CcConf c] iters of + case cast @[HitlTestCase HwTargetRef q r] @[HitlTestCase HwTargetRef q CcConf] iters of Just q -> Just ( show topEntity