Add Clash FFI interface tests & bugfixes

.ci/gitlab/test.yml

@@ -133,6 +133,11 @@ suite:cores:
     - local
     - vivado-2022.1-standard
 
+ffi:interface-tests:
+  extends: .test-cache-local
+  script:
+    - ./dist-newstyle/build/*/*/clash-ffi-*/x/ffi-interface-tests/build/ffi-interface-tests/ffi-interface-tests --smallcheck-max-count 2000
+
 ffi:example:
   extends: .test-cache-local
   script:

clash-ffi/clash-ffi.cabal

@@ -12,14 +12,9 @@ maintainer:         [email protected]
 copyright:          Copyright © 2022, QBayLogic B.V.
 category:           Hardware
 
-library
+common common-options
   default-language: Haskell2010
   default-extensions:
-    BangPatterns
-    DeriveAnyClass
-    DeriveGeneric
-    DerivingStrategies
-    GeneralizedNewtypeDeriving
     ScopedTypeVariables
     TypeApplications
   ghc-options:
@@ -29,12 +24,28 @@ library
     bytestring              >= 0.10 && < 0.12,
     clash-prelude           >= 1.2  && < 1.8,
     deepseq                 >= 1.4  && < 1.5,
+  include-dirs: include
+  includes: vpi_user.h
+  cpp-options:
+    -DVERILOG=1
+    -DIVERILOG=1
+    -DVERILOG_2001=1
+    -DVERILOG_2005=1
+    -DVPI_VECVAL=1
+
+library
+  import: common-options
+  default-extensions:
+    BangPatterns
+    DeriveAnyClass
+    DeriveGeneric
+    DerivingStrategies
+    GeneralizedNewtypeDeriving
+  build-depends:
     derive-storable         >= 0.3  && < 0.4,
     derive-storable-plugin  >= 0.2  && < 0.3,
     mtl                     >= 2.2  && < 2.3,
   hs-source-dirs: src
-  include-dirs: include
-  includes: vpi_user.h
   c-sources: cbits/entry_vpi.c
   exposed-modules:
     Clash.FFI.Monad
@@ -64,9 +75,34 @@ library
     Clash.FFI.VPI.Port
     Clash.FFI.VPI.Port.Direction
     Clash.FFI.VPI.Reg
-  cpp-options:
-    -DVERILOG=1
-    -DIVERILOG=1
-    -DVERILOG_2001=1
-    -DVERILOG_2005=1
-    -DVPI_VECVAL=1
+
+executable ffi-interface-tests
+  import: common-options
+  default-extensions:
+    DataKinds
+    RankNTypes
+    LambdaCase
+    ViewPatterns
+    TupleSections
+    ImplicitParams
+    FlexibleContexts
+    FlexibleInstances
+    MultiParamTypeClasses
+    ExistentialQuantification
+  hs-source-dirs: tests
+  main-is: Main.hs
+  other-modules:
+    Clash.FFI.Test
+    Clash.FFI.Test.Instances
+  include-dirs: tests/cbits
+  c-sources:
+    tests/cbits/VPI.c
+    tests/cbits/Test.c
+    tests/cbits/Pipe.c
+    tests/cbits/Print.c
+  build-depends:
+    , clash-ffi
+    , smallcheck
+    , tasty
+    , tasty-hunit
+    , tasty-smallcheck

clash-ffi/example/run-iverilog.sh

@@ -3,13 +3,13 @@
 # This is just a minimalistic script for demonstrating the process of
 # running the clash-ffi example using the Icarus Verilog VVP runtime
 # engine. The script is not designed to work in any possible system
-# environment and may not work immediatly for you. It is intended to
-# serve as an easy starter instead. Adapt it too you needs if it's not
+# environment and may not work immediately for you. It is intended to
+# serve as an easy starter instead. Adapt it to your needs if it's not
 # working out-of-the-box for you.
 
 ###############################
 
-# adapt these variables, if the tools are not in your PATH already
+# Adjust these variables if the tools are not in your PATH already
 
 # Cabal
 # https://www.haskell.org/cabal

clash-ffi/src/Clash/FFI/Monad.hs

@@ -4,6 +4,8 @@ License:      BSD2 (see the file LICENSE)
 Maintainer:   QBayLogic B.V. <[email protected]>
 -}
 
+{-# LANGUAGE CPP #-}
+
 module Clash.FFI.Monad
   ( SimCont
   , SimAction
@@ -33,6 +35,15 @@ import           Foreign.Storable (Storable)
 import qualified Foreign.Storable as FFI (peek)
 import           GHC.Stack (HasCallStack)
 
+#if MIN_VERSION_base(4,9,0)
+#ifdef MIN_VERSION_GLASGOW_HASKELL
+#if MIN_VERSION_GLASGOW_HASKELL(8,8,4,0)
+#else
+import Control.Monad.Fail (MonadFail)
+#endif
+#endif
+#endif
+
 {-
 NOTE [continuation-based API]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -69,17 +80,22 @@ same way, e.g.
 -- 'runSimAction'.
 --
 newtype SimCont o i = SimCont (ContT o IO i)
-  deriving newtype (Applicative, Functor, Monad, MonadCont, MonadIO, MonadFail)
+  deriving newtype
+    ( Applicative, Functor, Monad, MonadCont, MonadIO
+#if MIN_VERSION_base(4,9,0)
+    , MonadFail
+#endif
+    )
 
 -- | The type of an VPI "main" action run in @clash-ffi@. For the more general
 -- type of FFI computations, use 'SimCont'.
 --
-type SimAction = SimCont () ()
+type SimAction a = SimCont a a
 
 -- | Run a VPI "main" action. See 'SimAction' and 'SimCont' for more
 -- information.
 --
-runSimAction :: SimAction -> IO ()
+runSimAction :: SimAction a -> IO a
 runSimAction (SimCont cont) = Cont.runContT cont pure
 
 -- | Lift a continuation into a simulation FFI action.

clash-ffi/src/Clash/FFI/VPI/Callback/Reason.hs

@@ -218,7 +218,7 @@ instance UnsafeSend CallbackReason where
     AfterDelay mObject time -> do
       let object = maybe nullObject coerce mObject
       ctime <- pokeSend time
-      pure (7, object, ctime, FFI.nullPtr)
+      pure (9, object, ctime, FFI.nullPtr)
 
     EndOfCompile ->
       pure (10, nullObject, FFI.nullPtr, FFI.nullPtr)
@@ -303,7 +303,7 @@ instance UnsafeSend CallbackReason where
     NbaSynch mObject time -> do
       let object = maybe nullObject coerce mObject
       ctime <- pokeSend time
-      pure (31, object, ctime, FFI.nullPtr)
+      pure (30, object, ctime, FFI.nullPtr)
 
     AtEndOfSimTime mObject time -> do
       let object = maybe nullObject coerce mObject

clash-ffi/src/Clash/FFI/VPI/Error.hs

@@ -87,7 +87,7 @@ instance UnsafeReceive ErrorInfo where
 instance Receive ErrorInfo where
   receive cerror = do
     state <- receive (cerrorState cerror)
-    level <- receive (cerrorState cerror)
+    level <- receive (cerrorLevel cerror)
     msg <- receive (cerrorMessage cerror)
     prod <- receive (cerrorProduct cerror)
     code <- receive (cerrorCode cerror)

clash-ffi/src/Clash/FFI/VPI/IO.hs

@@ -22,7 +22,7 @@ import           GHC.Stack (CallStack, HasCallStack, callStack, prettyCallStack)
 
 import           Clash.FFI.Monad (SimCont)
 import qualified Clash.FFI.Monad as Sim (throw)
-import           Clash.FFI.View (unsafeSend)
+import           Clash.FFI.View (unsafeSend, ensureNullTerminated)
 
 foreign import ccall "vpi_user.h vpi_printf"
   c_vpi_printf :: CString -> IO CInt
@@ -37,7 +37,7 @@ simPutStr
   => ByteString
   -> SimCont o ()
 simPutStr =
-  unsafeSend >=> IO.liftIO . Monad.void . c_vpi_printf
+  (unsafeSend >=> IO.liftIO . Monad.void . c_vpi_printf) . ensureNullTerminated
 
 -- | A version of 'putStrLn' which outputs to the handle used by the simulator.
 -- When running a VPI callback, the normal functions provided in @base@ may

clash-ffi/src/Clash/FFI/VPI/Info.hs

@@ -5,6 +5,7 @@ Maintainer:   QBayLogic B.V. <[email protected]>
 -}
 
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RecordWildCards #-}
 
 -- Used to improve the performance of derived instances.
 {-# OPTIONS_GHC -fplugin=Foreign.Storable.Generic.Plugin #-}
@@ -51,7 +52,7 @@ data CInfo = CInfo
 
 -- | Information about the simulator connected to over VPI. This includes the
 -- command line used to start the simulation tool. Depending on the simulator
--- this may include / remove arguments recognised by the simulator (i.e. it
+-- this may include / remove arguments recognized by the simulator (i.e. it
 -- will only contain other flags like RTS flags).
 --
 data Info = Info
@@ -64,20 +65,20 @@ data Info = Info
 type instance CRepr Info = CInfo
 
 instance UnsafeReceive Info where
-  unsafeReceive cinfo = do
+  unsafeReceive CInfo{..} = do
     -- When passing +RTS to some simulators, they may replace the whole
-    -- argument with NULL, so we check for that instead of using argc.
-    args <- unsafeReceiveArray0 FFI.nullPtr (cinfoArgv cinfo)
-    prod <- unsafeReceive (cinfoProduct cinfo)
-    ver  <- unsafeReceive (cinfoVersion cinfo)
+    -- argument with NULL, so we check in addition to argc.
+    args <- unsafeReceiveArray0 (fromEnum cinfoArgc) FFI.nullPtr cinfoArgv
+    prod <- unsafeReceive cinfoProduct
+    ver  <- unsafeReceive cinfoVersion
 
     pure (Info args prod ver)
 
 instance Receive Info where
-  receive cinfo = do
-    args <- receiveArray0 FFI.nullPtr (cinfoArgv cinfo)
-    prod <- receive (cinfoProduct cinfo)
-    ver  <- receive (cinfoVersion cinfo)
+  receive CInfo{..} = do
+    args <- receiveArray0 (fromEnum cinfoArgc) FFI.nullPtr cinfoArgv
+    prod <- receive cinfoProduct
+    ver  <- receive cinfoVersion
 
     pure (Info args prod ver)
 

clash-ffi/src/Clash/FFI/VPI/Module.hs

@@ -19,6 +19,7 @@ import Data.ByteString (ByteString)
 import Foreign.Storable (Storable)
 import GHC.Stack (HasCallStack)
 
+import Clash.FFI.View (ensureNullTerminated)
 import Clash.FFI.Monad (SimCont)
 import Clash.FFI.VPI.Iterator
 import Clash.FFI.VPI.Object
@@ -49,7 +50,8 @@ topModules = iterateAll @_ @Object ObjModule Nothing
 -- exception if no top-level module with the given name is found in the design.
 --
 findTopModule :: HasCallStack => ByteString -> SimCont o Module
-findTopModule name = unsafeSendChildRef @_ @Object name Nothing
+findTopModule name =
+  unsafeSendChildRef @_ @Object (ensureNullTerminated name) Nothing
 
 -- | Iterate all the nets in a module. This will iterate all nets at once, for
 -- large designs it may be more efficient to use

clash-ffi/src/Clash/FFI/VPI/Object/Value.hs

@@ -207,7 +207,7 @@ instance UnsafeSend Value where
 #endif
 
     StringVal size str -> do
-      cvalue <- CStringVal <$> unsafeSend str
+      cvalue <- CStringVal <$> unsafeSend (ensureNullTerminated str)
       pure (CValueSized cvalue (snatToNum size))
 
     TimeVal time -> do
@@ -241,7 +241,7 @@ instance Send Value where
 #endif
 
     StringVal size str -> do
-      cvalue <- CStringVal <$> send str
+      cvalue <- CStringVal <$> send (ensureNullTerminated str)
       pure (CValueSized cvalue (snatToNum size))
 
     TimeVal time -> do