[Haskell-cafe] fcntl locks, executeFile and threaded runtime

[diego souza]

Howdy,

I've tested the previous program with all versions down to 6.12.3 and
I've got the same results. Then I tried something different:

  main = do
    let lock = (WriteLock, AbsoluteSeek, 0, 0)
    fd <- openFd "/tmp/foobar" ReadWrite (Just stdFileMode) defaultFileFlags {trunc=True}
    setLock fd lock >> putStrLn "parent: locked!"
   
    pid <- forkProcess $ do
      setLock fd lock >> putStrLn "child: locked!"
      executeFile "/usr/bin/sleep" False ["5"] Nothing
   
    void $ getProcessStatus True False pid

Which, always works as it supposes to: child process always fail
to acquire the lock.

The following one is quite interesting, though. The moment I insert
the threadDelay function (like in the previous example), it fails some
times (it seems to have something to do with cpu idleness). I guess
this this explains why the previous version didn't work properly for
me:

  main = do
    let lock = (WriteLock, AbsoluteSeek, 0, 0)
    fd <- openFd "/tmp/foobar" ReadWrite (Just stdFileMode) defaultFileFlags {trunc=True}
   
    pid0 <- forkProcess $ do
      setLock fd lock >> putStrLn "child0: locked!"
      executeFile "/usr/bin/sleep" False ["5"] Nothing

    pid1 <- forkProcess $ do
      setLock fd lock >> putStrLn "child1: locked!"
      executeFile "/usr/bin/sleep" False ["5"] Nothing
   
    threadDelay $ 1 * 1000 * 1000 -- take out this line and everything works
    mapM_ (getProcessStatus True False) [pid1, pid2]

$ ghc -threaded -fforce-recomp --make -O2 ~/test; for _ in `seq 1 10`; do ~/test; echo; done;                                                           
[1 of 1] Compiling Main             ( /home/dsouza/test.hs, /home/dsouza/test.o )
Linking /home/dsouza/test ...
parent: locked!
test: setLock: resource exhausted (Resource temporarily unavailable)

parent: locked!
child: locked!

child: locked!
test: setLock: resource exhausted (Resource temporarily unavailable)

child: locked!
test: setLock: resource exhausted (Resource temporarily unavailable)

parent: locked!
test: setLock: resource exhausted (Resource temporarily unavailable)

parent: locked!
child: locked!

child: locked!
test: setLock: resource exhausted (Resource temporarily unavailable)

parent: locked!
child: locked!

parent: locked!
child: locked!

child: locked!
parent: locked!

Am I doing something wrong?

Thanks!
~dsouza