Search code examples
haskellquickcheck

Generate stateful function pointer for FFI testing


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.


Solution

  • 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;
    }