Generate stateful function pointer for FFI testing-CodePudding

I want to generate stateful functions (C signature T f()) with QuickCheck as arguments for foreign functions. Preferably I also want to make them (or their inner s->(T,s)) showable.

I know that for stateless functions I can write something like

type Compare = CInt -> CInt -> CBool
foreign import ccall "wrapper"
  mkCompare :: Compare -> IO (FunPtr Compare)

but I got stuck trying this approach for the stateful functions, as I don't see how I can translate the monad hiding the state in Haskell to the function hiding the state in C.

Example of a stateful function f

static int i = 0;

int f() {
    return i  ;
}

In Haskell I would represent this function as State (\s -> (s,s 1)).

What does QuickCheck have to do with it?

If I have a C function that takes a stateful function as argument, e.g.

int twice(int (*f)()) {
    f();
    return f();
}

then I can test the function with QuickCheck, where QuickCheck can generate different implementations for f, which would usually look similar to

prop_total (Fun f) xs = total $ g f xs

but these generated functions are stateless, not stateful like the example C function above.

CodePudding user response：

Thanks to Daniel Wagner's suggestion in the comments, I could figure it out. The Show instance comes for free. Here's a minimal example that I ran with

gcc -fPIC -shared -o libstateful.dylib stateful.c && ghc -L. Stateful.hs -lstateful && ./Stateful

As expected it will output a distribution of about 50% of 1 (True) and 50% of 0 (False).

Stateful.hs

import Data.IORef
import Foreign.C
import Foreign.Ptr
import System.IO.Unsafe
import Test.QuickCheck

instance CoArbitrary CInt where
  coarbitrary = coarbitraryIntegral

instance Arbitrary CBool where
  arbitrary = chooseEnum (0,1)
  shrink 1 = [0]
  shrink 0 = []

instance Function CInt where
  function = functionIntegral

type Generator = IO CBool

foreign import ccall "wrapper" mkGenerator :: Generator -> IO (FunPtr Generator)

foreign import ccall "changes" changes :: FunPtr Generator -> IO CBool

type StateFn = CInt -> (CBool,CInt)

stateFnToIORef :: StateFn -> IORef CInt -> IO CBool
stateFnToIORef f s_ref = do
    s <- readIORef s_ref
    let (a,s') = f s
    writeIORef s_ref s'
    pure a

prop_changes :: Fun CInt (CBool,CInt) -> Property
prop_changes (Fn f) = unsafePerformIO (do
    x_ref <- newIORef 0
    f' <- mkGenerator $ stateFnToIORef f x_ref
    res <- changes f'
    pure $ collect res (total res))

main :: IO ()
main = quickCheck prop_changes

stateful.c

_Bool changes(_Bool (*f)()) {
    _Bool x = f();
    _Bool y = f();
    return x != y;
}