Bug in 4.08.1 hslib/concurrent/semaphores....

[Marcus Shawcroft]

Hi,

I'm using 4.08.1 on linux.

I think that `waitQSemN' provided with the concurrent library is broken,
the following code should drop straight through, in practice waitQSemN
blocks.....


> module Main (main) where

> import Concurrent

> main :: IO ()
> main
>   = do sem <- newQSemN 1
>            waitQSemN sem 1


Below is my fix:

Index: QSemN.lhs
===================================================================
RCS file: /export/home1/CVSROOT/fptools/hslibs/concurrent/QSemN.lhs,v
retrieving revision 1.1.1.1
diff -c -r1.1.1.1 QSemN.lhs
*** QSemN.lhs 2000/09/18 09:44:34 1.1.1.1
--- QSemN.lhs 2001/01/10 14:30:44
***************
*** 39,45 ****
  waitQSemN :: QSemN -> Int -> IO ()
  waitQSemN (QSemN sem) sz = do
    (avail,blocked) <- takeMVar sem   -- gain ex. access
!   if (avail - sz) > 0 then
         -- discharging 'sz' still leaves the semaphore
         -- in an 'unblocked' state.
       putMVar sem (avail-sz,[])
--- 39,45 ----
  waitQSemN :: QSemN -> Int -> IO ()
  waitQSemN (QSemN sem) sz = do
    (avail,blocked) <- takeMVar sem   -- gain ex. access
!   if (avail - sz) >= 0 then
         -- discharging 'sz' still leaves the semaphore
         -- in an 'unblocked' state.
       putMVar sem (avail-sz,[])


Cheers
/Marcus

--
Marcus Shawcroft
Ericsson Mobile Applications


-------------- next part --------------
A non-text attachment was scrubbed...
Name: smime.p7s
Type: application/x-pkcs7-signature
Size: 2095 bytes
Desc: S/MIME Cryptographic Signature
Url : http://www.haskell.org/pipermail/glasgow-haskell-bugs/attachments/20010110/b45bbf10/smime.bin