From: simonmar <unknown>
Date: Tue, 3 Dec 2002 14:30:12 +0000 (+0000)
Subject: [project @ 2002-12-03 14:30:12 by simonmar]
X-Git-Tag: nhc98-1-18-release~792
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=c02cf39e4519f85d048bd5f0608de576eab9cabe;p=haskell-directory.git

[project @ 2002-12-03 14:30:12 by simonmar]
Eeek!  A nasty bug has been lurking in waitQSemN, which as far as I
can make out has been there for ever.  Presumably no-one uses this
abstraction...

The bug is that waitQSemN would discard any other blocked threads
(presumably waiting for a larger chunk of the semaphore) if it
succeeds.

It still looks to me like the quantity semaphores in here can suffer
from starvation: if one thread requests a large chunk, while lots of
other threads are requesting smaller chunks, then the thread
requesting the large chunk might never get to run.  I'm sure this must
be a well-known problem.

MERGE TO STABLE
---

diff --git a/Control/Concurrent/QSemN.hs b/Control/Concurrent/QSemN.hs
index 8e95903..d8d6f49 100644
--- a/Control/Concurrent/QSemN.hs
+++ b/Control/Concurrent/QSemN.hs
@@ -42,7 +42,7 @@ waitQSemN (QSemN sem) sz = do
   if (avail - sz) >= 0 then
        -- discharging 'sz' still leaves the semaphore
        -- in an 'unblocked' state.
-     putMVar sem (avail-sz,[])
+     putMVar sem (avail-sz,blocked)
    else do
      block <- newEmptyMVar
      putMVar sem (avail, blocked++[(sz,block)])