Commit d87bb656 authored by Matthias Treydte's avatar Matthias Treydte Committed by Ben Gamari

KQueue: Fix write notification requests being ignored...

when read notifications are requested, too (#13903)
Signed-off-by: default avatarMatthias Treydte <mt@waldheinz.de>

KQueue: Drop Bits/FiniteBits instances for Filter as they are really
constants whose bits should not be fiddled with
Signed-off-by: default avatarMatthias Treydte <mt@waldheinz.de>

Reviewers: austin, hvr, bgamari

Reviewed By: bgamari

Subscribers: gridaphobe, kazu_yamamoto, rwbarton, thomie

GHC Trac Issues: #13903

Differential Revision: https://phabricator.haskell.org/D3692

(cherry picked from commit 6c3eafb3)
parent ebf8e076
......@@ -28,11 +28,13 @@ available = False
import Data.Bits (Bits(..), FiniteBits(..))
import Data.Int
import Data.Maybe ( catMaybes )
import Data.Word (Word16, Word32)
import Foreign.C.Error (throwErrnoIfMinus1, eINTR, eINVAL,
eNOTSUP, getErrno, throwErrno)
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Array (withArrayLen)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.Storable (Storable(..))
import GHC.Base
......@@ -85,23 +87,20 @@ delete kq = do
return ()
modifyFd :: KQueue -> Fd -> E.Event -> E.Event -> IO Bool
modifyFd kq fd oevt nevt
| nevt == mempty = do
let !ev = event fd (toFilter oevt) flagDelete noteEOF
kqueueControl (kqueueFd kq) ev
| otherwise = do
let !ev = event fd (toFilter nevt) flagAdd noteEOF
kqueueControl (kqueueFd kq) ev
toFilter :: E.Event -> Filter
toFilter evt
| evt `E.eventIs` E.evtRead = filterRead
| otherwise = filterWrite
modifyFd kq fd oevt nevt = kqueueControl (kqueueFd kq) evs
where
evs
| nevt == mempty = toEvents fd (toFilter oevt) flagDelete noteEOF
| otherwise = toEvents fd (toFilter nevt) flagAdd noteEOF
toFilter :: E.Event -> [Filter]
toFilter e = catMaybes [ check E.evtRead filterRead, check E.evtWrite filterWrite ]
where
check e' f = if e `E.eventIs` e' then Just f else Nothing
modifyFdOnce :: KQueue -> Fd -> E.Event -> IO Bool
modifyFdOnce kq fd evt = do
let !ev = event fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF
kqueueControl (kqueueFd kq) ev
modifyFdOnce kq fd evt =
kqueueControl (kqueueFd kq) (toEvents fd (toFilter evt) (flagAdd .|. flagOneshot) noteEOF)
poll :: KQueue
-> Maybe Timeout
......@@ -140,8 +139,8 @@ data Event = KEvent {
, udata :: {-# UNPACK #-} !(Ptr ())
} deriving Show
event :: Fd -> Filter -> Flag -> FFlag -> Event
event fd filt flag fflag = KEvent (fromIntegral fd) filt flag fflag 0 nullPtr
toEvents :: Fd -> [Filter] -> Flag -> FFlag -> [Event]
toEvents fd flts flag fflag = map (\filt -> KEvent (fromIntegral fd) filt flag fflag 0 nullPtr) flts
-- | @since 4.3.1.0
instance Storable Event where
......@@ -192,7 +191,7 @@ newtype Filter = Filter Int32
#else
newtype Filter = Filter Int16
#endif
deriving (Bits, FiniteBits, Eq, Num, Show, Storable)
deriving (Eq, Num, Show, Storable)
filterRead :: Filter
filterRead = Filter (#const EVFILT_READ)
......@@ -222,11 +221,11 @@ instance Storable TimeSpec where
kqueue :: IO KQueueFd
kqueue = KQueueFd `fmap` throwErrnoIfMinus1 "kqueue" c_kqueue
kqueueControl :: KQueueFd -> Event -> IO Bool
kqueueControl kfd ev =
kqueueControl :: KQueueFd -> [Event] -> IO Bool
kqueueControl kfd evts =
withTimeSpec (TimeSpec 0 0) $ \tp ->
withEvent ev $ \evp -> do
res <- kevent False kfd evp 1 nullPtr 0 tp
withArrayLen evts $ \evlen evp -> do
res <- kevent False kfd evp evlen nullPtr 0 tp
if res == -1
then do
err <- getErrno
......@@ -255,9 +254,6 @@ kevent safe k chs chlen evs evlen ts
| safe = c_kevent k chs (fromIntegral chlen) evs (fromIntegral evlen) ts
| otherwise = c_kevent_unsafe k chs (fromIntegral chlen) evs (fromIntegral evlen) ts
withEvent :: Event -> (Ptr Event -> IO a) -> IO a
withEvent ev f = alloca $ \ptr -> poke ptr ev >> f ptr
withTimeSpec :: TimeSpec -> (Ptr TimeSpec -> IO a) -> IO a
withTimeSpec ts f
| tv_sec ts < 0 = f nullPtr
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment