Hedgehog Integration (WIP)

Author: kleinreact

clash-testbench/src/Clash/Testbench/Generate.hs

@@ -10,7 +10,7 @@ module Clash.Testbench.Generate where
 
 import Hedgehog
 import Hedgehog.Gen
-import Control.Monad.State.Lazy (liftIO)
+import Control.Monad.State.Lazy (liftIO, when, modify)
 import Data.IORef (newIORef, readIORef, writeIORef)
 
 import Clash.Prelude (KnownDomain(..), BitPack(..), NFDataX)
@@ -101,74 +101,85 @@ matchIOGen expectedOutput gen = do
   TBDomain{..} <- tbDomain @dom
 
   vRef <- liftIO $ newIORef undefined
-  simStepCache <- liftIO (readIORef simStepRef >>= newIORef)
+  checkForProgress <- progressCheck simStepRef False
 
   mind SomeSignal $ IOInput
     { signalId     = NoID
     , signalCurVal = const $ do
-        global <- readIORef simStepRef
-        local <- readIORef simStepCache
+        progress <- checkForProgress
 
-        if local == global
-        then readIORef vRef
-        else do
+        if progress
+        then do
           (i, o) <- sample gen
-          signalExpect expectedOutput $ Expectation (global + 1, verify o)
-
+          curStep <- readIORef simStepRef
+          signalExpect expectedOutput $ Expectation (curStep, verify o)
           writeIORef vRef i
-          writeIORef simStepCache global
+
           return i
+        else
+          readIORef vRef
     , signalPrint  = Nothing
     }
+
  where
-  verify x y
-    | x == y    = Nothing
-    | otherwise = Just $ "Expected " <> show x <> " but the output is " <> show y
+  verify x y = do
+    when (x /= y)
+      $ footnote
+      $ "Expected '" <> show x <> "' but the output is '" <> show y <> "'"
+    x === x
 
 -- | Extended version of 'matchIOGen', which allows to specify valid
--- IO behavior over a finite amount of simulation steps. The generator
--- is repeatedly called after all steps of a generation have been
--- verified.
+-- IO behavior over a finite amount of simulation steps. During native
+-- simulation (no property check), the generator is repeatedly called
+-- after all the generated simulation steps have been consumed. The
+-- generator is only called once if the test bench is converted to a
+-- property instead.
 matchIOGenN ::
   forall dom i o.
   (NFDataX i, BitPack i, KnownDomain dom, Eq o, Show o, Show i) =>
   TBSignal dom o -> Gen [(i, o)] -> TB (TBSignal dom i)
 matchIOGenN expectedOutput gen = do
   TBDomain{..} <- tbDomain @dom
 
-  vRef <- liftIO $ newIORef []
-  simStepCache <- liftIO (readIORef simStepRef >>= newIORef)
+  xs <- liftIO $ sample gen
+  modify $ \st@ST{..} -> st { simSteps = max simSteps $ length xs }
+
+  vRef <- liftIO $ newIORef xs
+  checkForProgress <- progressCheck simStepRef False
 
   mind SomeSignal $ IOInput
-    { signalId     = NoID
+    { signalId = NoID
     , signalCurVal = const $ do
-        global <- readIORef simStepRef
-        local <- readIORef simStepCache
+        progress <- checkForProgress
 
-        if local == global
-        then readIORef vRef >>= \case
-          (i, _) : _ -> return i
-          [] -> do
-            (i, o) : xr <- sample gen
-            writeIORef vRef ((i, o) : xr)
-            Prelude.print $ (i, o) : xr
-            return i
-        else do
-          writeIORef simStepCache global
-          readIORef vRef >>= \case
+        readIORef vRef >>=
+          if progress
+          then \case
             _ : (i, o) : xr -> do
               writeIORef vRef ((i, o) : xr)
-              signalExpect expectedOutput $ Expectation (global + 1, verify o)
+              curStep <- readIORef simStepRef
+              signalExpect expectedOutput $ Expectation (curStep, verify o)
               return i
             _ -> do
               (i, o) : xr <- sample gen
-              Prelude.print $ (i, o) : xr
+
               writeIORef vRef ((i, o) : xr)
-              signalExpect expectedOutput $ Expectation (global + 1, verify o)
+              curStep <- readIORef simStepRef
+              signalExpect expectedOutput $ Expectation (curStep, verify o)
               return i
-    , signalPrint  = Nothing
+          else \case
+            (i, _) : _ -> return i
+            [] -> do
+              (i, o) : xr <- sample gen
+              writeIORef vRef ((i, o) : xr)
+              Prelude.print $ (i, o) : xr
+              return i
+    , signalPrint = Nothing
     }
+
  where
-  verify x y
-    | x == y    = Nothing
-    | otherwise = Just $ "Expected '" <> show x <> "' but the output is '" <> show y <> "'"
+  verify x y = do
+    when (x /= y)
+      $ footnote
+      $ "Expected '" <> show x <> "' but the output is '" <> show y <> "'"
+    x === x

clash-testbench/src/Clash/Testbench/Input.hs

@@ -12,8 +12,6 @@ module Clash.Testbench.Input
 
 import Control.Monad.State.Lazy
 import Data.IORef
-import Data.Maybe (fromMaybe)
-import Data.List (uncons)
 
 import Clash.Prelude (KnownDomain(..), BitPack(..), NFDataX)
 
@@ -22,33 +20,58 @@ import Clash.Testbench.Internal.Signal hiding (TBSignal)
 import Clash.Testbench.Internal.Monad
 import Clash.Testbench.Internal.ID
 
+-- | The mode defines how to expand finite lists towards infinite
+-- ones. If a list is already infinite, then it does not matter which
+-- mode is chosen at this point.
+data ExpansionMode a =
+    Repeat
+    -- ^ Repeat a finite list indefinitely. This mode causes an error
+    -- if the list to be repeated is the empty list.
+  | Default a
+    -- ^ Repeat a given default value after the end of a finite list
+    -- has been reached.
+  | IsInfinite
+    -- ^ The list has to be infinite. This mode causes an error if the
+    -- end of a finite list is reached.
+
 -- | Creates an input signal whose values are taken from a finite or
 -- infinite list. If the list is finite and the number of simulation
 -- steps exceeds the length of the list, then the value of the first
 -- argument is used repeatedly.
 fromList :: forall dom a.
-  (KnownDomain dom, BitPack a, NFDataX a, Show a) =>
-  a -> [a] -> TB (TBSignal dom a)
-fromList x xs = do
+  (KnownDomain dom, BitPack a, NFDataX a) =>
+  ExpansionMode a -> [a] -> TB (TBSignal dom a)
+
+fromList Repeat [] =
+  error $ "Clash.Testbench.Input.fromList: "
+       <> "The empty list cannot be repeated indefinitely."
+
+fromList mode xs = do
   TBDomain{..} <- tbDomain @dom
 
-  listRef <- liftIO $ newIORef $ x : xs
-  simStepCache <- liftIO (readIORef simStepRef >>= newIORef)
+  vRef <- liftIO $ newIORef xs
+  checkForProgress <- progressCheck simStepRef False
 
   mind SomeSignal $ IOInput
     { signalId     = NoID
     , signalPrint  = Nothing
     , signalCurVal = const $ do
-        (r, rs) <- fromMaybe (x, []) . uncons <$> readIORef listRef
-        global <- readIORef simStepRef
-        local <- readIORef simStepCache
-
-        if local == global
-        then return r
-        else do
-          writeIORef listRef rs
-          writeIORef simStepCache global
-          return $ case rs of
-            []  -> x
-            y:_ -> y
+        readIORef vRef >>= \case
+          [] -> case mode of
+            Repeat -> do
+              let (x : xr) = xs
+              writeIORef vRef xr
+              return x
+            Default v ->
+              return v
+            IsInfinite ->
+              error $ "Clash.Testbench.Input.fromList: "
+                   <> "End of list reached."
+          x : xr -> do
+            progress <- checkForProgress
+
+            when progress $
+              writeIORef vRef xr
+
+            return x
     }