X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=System%2FPosix%2FInternals.hs;h=2a6126cdc0fc4965e8a7d1032f446cac0cabff31;hb=41e8fba828acbae1751628af50849f5352b27873;hp=2ea9fb1c687f33ac7070f1499d5f532d8d1a349f;hpb=0ec5766c8d6d2a2352f1ace463edaf428c9eea5a;p=ghc-base.git

diff --git a/System/Posix/Internals.hs b/System/Posix/Internals.hs
index 2ea9fb1..2a6126c 100644
--- a/System/Posix/Internals.hs
+++ b/System/Posix/Internals.hs
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -XNoImplicitPrelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude, ForeignFunctionInterface #-}
 {-# OPTIONS_GHC -fno-warn-unused-binds #-}
 {-# OPTIONS_HADDOCK hide #-}
 
@@ -311,6 +311,9 @@ foreign import ccall unsafe "consUtils.h set_console_echo__"
 foreign import ccall unsafe "consUtils.h get_console_echo__"
    get_console_echo :: CInt -> IO CInt
 
+foreign import ccall unsafe "consUtils.h is_console__"
+   is_console :: CInt -> IO CInt
+
 #endif
 
 -- ---------------------------------------------------------------------------
@@ -321,14 +324,14 @@ setNonBlockingFD :: FD -> Bool -> IO ()
 setNonBlockingFD fd set = do
   flags <- throwErrnoIfMinus1Retry "setNonBlockingFD"
                  (c_fcntl_read fd const_f_getfl)
-  -- An error when setting O_NONBLOCK isn't fatal: on some systems 
-  -- there are certain file handles on which this will fail (eg. /dev/null
-  -- on FreeBSD) so we throw away the return code from fcntl_write.
   let flags' | set       = flags .|. o_NONBLOCK
              | otherwise = flags .&. complement o_NONBLOCK
   unless (flags == flags') $ do
-    throwErrnoIfMinus1Retry_ "fcntl_write" $
-        c_fcntl_write fd const_f_setfl (fromIntegral flags')
+    -- An error when setting O_NONBLOCK isn't fatal: on some systems
+    -- there are certain file handles on which this will fail (eg. /dev/null
+    -- on FreeBSD) so we throw away the return code from fcntl_write.
+    _ <- c_fcntl_write fd const_f_setfl (fromIntegral flags')
+    return ()
 #else
 
 -- bogus defns for win32