problem with FFI and libsane

[Ganesh Sittampalam]

Hi,

I'm having some trouble making Haskell bindings to libsane (a scanner
access library: http://www.sane-project.org/)

When I build the cut down sample of my code (below) with GHC 7.4.1 with
the non-threaded runtime, it hangs at runtime in the call to
c'sane_get_devices (after printing "go"). Pressing ^C causes it to
continue and print "done" before exiting.

If I compile with GHC 7.2.2 non-threaded, it doesn't hang, printing
first "go" then "done" after a few seconds. That pause is expected, as
it's also seen in the equivalent C version (also below).

If I switch to the threaded runtime, then things go wrong differently.
Most of the time there's a hang after "go" and after pressing ^C they
just exit immediately, without printing "done". This doesn't change
between 7.2.2 and 7.4.1. Occasionally, things do work and I get "go"
then "done".

All these symptoms seem to point to some kind of threading problem, and
I believe that libsane is using pthreads, although ldd doesn't report it
and strace only shows it loading the library.

The platform is Linux x86, and I've reproduced the behaviour on two
different machines (Debian and Ubuntu). I've also tried with GHC
7.4.1.20120508, the most recent i386 snapshot I could fine.

Is there anything obvious I'm doing wrong, or something I could try next?

Cheers,

Ganesh

Haskell code:

{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign.Marshal.Alloc
import Foreign.Ptr
import System.IO
import Foreign.C.Types

foreign import ccall "sane_init" c'sane_init
  :: Ptr CInt -> Callback -> IO CUInt

type Callback = FunPtr (Ptr CChar -> Ptr CChar -> Ptr CChar -> IO ())

foreign import ccall "sane_exit" c'sane_exit
  :: IO ()

-- the () in the ptr type is incorrect, but in
-- this cut-down example we never try to dereference it
foreign import ccall "sane_get_devices" c'sane_get_devices
  :: Ptr (Ptr (Ptr ())) -> CInt -> IO CUInt


main :: IO ()
main = do
   hSetBuffering stdout NoBuffering
   _ <- c'sane_init nullPtr nullFunPtr
   putStrLn "go"
   ptr <- malloc
   _ <- c'sane_get_devices ptr 0
   putStrLn "done"
   c'sane_exit


C code:

#include <sane/sane.h>
#include <stdlib.h>

int main()
{
   sane_init(NULL, NULL);
   puts("go");
   const SANE_Device **ptr;
   sane_get_devices(&ptr, 0);
   puts("done");
   sane_exit();
}