projects
/
ghc-base.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (from parent 1:
328a2c4
)
Add errno to the IOError type
author
Ian Lynagh
<igloo@earth.li>
Sun, 4 Jan 2009 17:30:18 +0000
(17:30 +0000)
committer
Ian Lynagh
<igloo@earth.li>
Sun, 4 Jan 2009 17:30:18 +0000
(17:30 +0000)
Foreign/C/Error.hs
patch
|
blob
|
history
Foreign/Marshal/Alloc.hs
patch
|
blob
|
history
GHC/Handle.hs
patch
|
blob
|
history
GHC/IO.hs
patch
|
blob
|
history
GHC/IOBase.lhs
patch
|
blob
|
history
System/Environment.hs
patch
|
blob
|
history
System/Exit.hs
patch
|
blob
|
history
System/IO/Error.hs
patch
|
blob
|
history
System/Posix/Internals.hs
patch
|
blob
|
history
diff --git
a/Foreign/C/Error.hs
b/Foreign/C/Error.hs
index
950a7a4
..
7c48180
100644
(file)
--- a/
Foreign/C/Error.hs
+++ b/
Foreign/C/Error.hs
@@
-498,8
+498,9
@@
errnoToIOError :: String -- ^ the location where the error occurred
errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
str <- strerror errno >>= peekCString
#if __GLASGOW_HASKELL__
errnoToIOError loc errno maybeHdl maybeName = unsafePerformIO $ do
str <- strerror errno >>= peekCString
#if __GLASGOW_HASKELL__
- return (IOError maybeHdl errType loc str maybeName)
+ return (IOError maybeHdl errType loc str (Just errno') maybeName)
where
where
+ Errno errno' = errno
errType
| errno == eOK = OtherError
| errno == e2BIG = ResourceExhausted
errType
| errno == eOK = OtherError
| errno == e2BIG = ResourceExhausted
diff --git
a/Foreign/Marshal/Alloc.hs
b/Foreign/Marshal/Alloc.hs
index
9fd576d
..
282791a
100644
(file)
--- a/
Foreign/Marshal/Alloc.hs
+++ b/
Foreign/Marshal/Alloc.hs
@@
-178,7
+178,10
@@
failWhenNULL :: String -> IO (Ptr a) -> IO (Ptr a)
failWhenNULL name f = do
addr <- f
if addr == nullPtr
failWhenNULL name f = do
addr <- f
if addr == nullPtr
-#if __GLASGOW_HASKELL__ || __HUGS__
+#if __GLASGOW_HASKELL__
+ then ioError (IOError Nothing ResourceExhausted name
+ "out of memory" Nothing Nothing)
+#elif __HUGS__
then ioError (IOError Nothing ResourceExhausted name
"out of memory" Nothing)
#else
then ioError (IOError Nothing ResourceExhausted name
"out of memory" Nothing)
#else
diff --git
a/GHC/Handle.hs
b/GHC/Handle.hs
index
97b7f88
..
6255a79
100644
(file)
--- a/
GHC/Handle.hs
+++ b/
GHC/Handle.hs
@@
-187,8
+187,8
@@
withHandle__' fun h m act =
return ()
augmentIOError :: IOException -> String -> Handle -> IOException
return ()
augmentIOError :: IOException -> String -> Handle -> IOException
-augmentIOError (IOError _ iot _ str fp) fun h
- = IOError (Just h) iot fun str filepath
+augmentIOError ioe@IOError{ ioe_filename = fp } fun h
+ = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
where filepath
| Just _ <- fp = fp
| otherwise = case h of
where filepath
| Just _ <- fp = fp
| otherwise = case h of
@@
-267,7
+267,7
@@
checkReadableHandle act handle_ =
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
ioException (IOError (Just h) IllegalOperation fun
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
ioException (IOError (Just h) IllegalOperation fun
- "handle is not seekable" Nothing)
+ "handle is not seekable" Nothing Nothing)
wantSeekableHandle fun h@(FileHandle _ m) act =
withHandle_' fun h m (checkSeekableHandle act)
wantSeekableHandle fun h@(FileHandle _ m) act =
withHandle_' fun h m (checkSeekableHandle act)
@@
-289,32
+289,32
@@
ioe_closedHandle, ioe_EOF,
ioe_closedHandle = ioException
(IOError Nothing IllegalOperation ""
ioe_closedHandle = ioException
(IOError Nothing IllegalOperation ""
- "handle is closed" Nothing)
+ "handle is closed" Nothing Nothing)
ioe_EOF = ioException
ioe_EOF = ioException
- (IOError Nothing EOF "" "" Nothing)
+ (IOError Nothing EOF "" "" Nothing Nothing)
ioe_notReadable = ioException
(IOError Nothing IllegalOperation ""
ioe_notReadable = ioException
(IOError Nothing IllegalOperation ""
- "handle is not open for reading" Nothing)
+ "handle is not open for reading" Nothing Nothing)
ioe_notWritable = ioException
(IOError Nothing IllegalOperation ""
ioe_notWritable = ioException
(IOError Nothing IllegalOperation ""
- "handle is not open for writing" Nothing)
+ "handle is not open for writing" Nothing Nothing)
ioe_notSeekable = ioException
(IOError Nothing IllegalOperation ""
ioe_notSeekable = ioException
(IOError Nothing IllegalOperation ""
- "handle is not seekable" Nothing)
+ "handle is not seekable" Nothing Nothing)
ioe_notSeekable_notBin = ioException
(IOError Nothing IllegalOperation ""
"seek operations on text-mode handles are not allowed on this platform"
ioe_notSeekable_notBin = ioException
(IOError Nothing IllegalOperation ""
"seek operations on text-mode handles are not allowed on this platform"
- Nothing)
+ Nothing Nothing)
ioe_finalizedHandle :: FilePath -> Handle__
ioe_finalizedHandle fp = throw
(IOError Nothing IllegalOperation ""
ioe_finalizedHandle :: FilePath -> Handle__
ioe_finalizedHandle fp = throw
(IOError Nothing IllegalOperation ""
- "handle is finalized" (Just fp))
+ "handle is finalized" Nothing (Just fp))
ioe_bufsiz :: Int -> IO a
ioe_bufsiz n = ioException
(IOError Nothing InvalidArgument "hSetBuffering"
ioe_bufsiz :: Int -> IO a
ioe_bufsiz n = ioException
(IOError Nothing InvalidArgument "hSetBuffering"
- ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
+ ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
-- 9 => should be parens'ified.
-- -----------------------------------------------------------------------------
-- 9 => should be parens'ified.
-- -----------------------------------------------------------------------------
@@
-843,8
+843,8
@@
stderr = unsafePerformIO $ do
-- Opening and Closing Files
addFilePathToIOError :: String -> FilePath -> IOException -> IOException
-- Opening and Closing Files
addFilePathToIOError :: String -> FilePath -> IOException -> IOException
-addFilePathToIOError fun fp (IOError h iot _ str _)
- = IOError h iot fun str (Just fp)
+addFilePathToIOError fun fp ioe
+ = ioe{ ioe_location = fun, ioe_filename = Just fp }
-- | Computation 'openFile' @file mode@ allocates and returns a new, open
-- handle to manage the file @file@. It manages input if @mode@
-- | Computation 'openFile' @file mode@ allocates and returns a new, open
-- handle to manage the file @file@. It manages input if @mode@
@@
-994,7
+994,7
@@
fdToHandle_stat fd mb_stat is_socket filepath mode binary = do
case fd_type of
Directory ->
ioException (IOError Nothing InappropriateType "openFile"
case fd_type of
Directory ->
ioException (IOError Nothing InappropriateType "openFile"
- "is a directory" Nothing)
+ "is a directory" Nothing Nothing)
-- regular files need to be locked
RegularFile -> do
-- regular files need to be locked
RegularFile -> do
@@
-1005,7
+1005,7
@@
fdToHandle_stat fd mb_stat is_socket filepath mode binary = do
r <- lockFile fd dev ino (fromBool write)
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
r <- lockFile fd dev ino (fromBool write)
when (r == -1) $
ioException (IOError Nothing ResourceBusy "openFile"
- "file is locked" Nothing)
+ "file is locked" Nothing Nothing)
#endif
mkFileHandle fd is_socket filepath ha_type binary
#endif
mkFileHandle fd is_socket filepath ha_type binary
@@
-1232,7
+1232,7
@@
hFileSize handle =
if r /= -1
then return r
else ioException (IOError Nothing InappropriateType "hFileSize"
if r /= -1
then return r
else ioException (IOError Nothing InappropriateType "hFileSize"
- "not a regular file" Nothing)
+ "not a regular file" Nothing Nothing)
-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
-- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
@@
-1746,7
+1746,7
@@
hDuplicateTo h1@(DuplexHandle _ r1 w1) h2@(DuplexHandle _ r2 w2) = do
withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)
hDuplicateTo h1 _ =
ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
withHandle' "hDuplicateTo" h1 r1 (dupHandleTo (Just w1) r2_)
hDuplicateTo h1 _ =
ioException (IOError (Just h1) IllegalOperation "hDuplicateTo"
- "handles are incompatible" Nothing)
+ "handles are incompatible" Nothing Nothing)
-- ---------------------------------------------------------------------------
-- showing Handles.
-- ---------------------------------------------------------------------------
-- showing Handles.
diff --git
a/GHC/IO.hs
b/GHC/IO.hs
index
e73b592
..
a17714f
100644
(file)
--- a/
GHC/IO.hs
+++ b/
GHC/IO.hs
@@
-341,7
+341,7
@@
lazyRead handle =
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
SemiClosedHandle -> lazyRead' handle handle_
_ -> ioException
(IOError (Just handle) IllegalOperation "lazyRead"
- "illegal handle type" Nothing)
+ "illegal handle type" Nothing Nothing)
lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])
lazyRead' h handle_ = do
lazyRead' :: Handle -> Handle__ -> IO (Handle__, [Char])
lazyRead' h handle_ = do
@@
-971,4
+971,4
@@
illegalBufferSize handle fn sz =
ioException (IOError (Just handle)
InvalidArgument fn
("illegal buffer size " ++ showsPrec 9 sz [])
ioException (IOError (Just handle)
InvalidArgument fn
("illegal buffer size " ++ showsPrec 9 sz [])
- Nothing)
+ Nothing Nothing)
diff --git
a/GHC/IOBase.lhs
b/GHC/IOBase.lhs
index
c15d6c7
..
48a0950
100644
(file)
--- a/
GHC/IOBase.lhs
+++ b/
GHC/IOBase.lhs
@@
-787,6
+787,7
@@
data IOException
ioe_type :: IOErrorType, -- what it was.
ioe_location :: String, -- location.
ioe_description :: String, -- error type specific information.
ioe_type :: IOErrorType, -- what it was.
ioe_location :: String, -- location.
ioe_description :: String, -- error type specific information.
+ ioe_errno :: Maybe CInt, -- errno leading to this error, if any.
ioe_filename :: Maybe FilePath -- filename the error is related to.
}
deriving Typeable
ioe_filename :: Maybe FilePath -- filename the error is related to.
}
deriving Typeable
@@
-794,8
+795,8
@@
data IOException
instance Exception IOException
instance Eq IOException where
instance Exception IOException
instance Eq IOException where
- (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
- e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
+ (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
+ e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
-- | An abstract type that contains a value for each variant of 'IOError'.
data IOErrorType
-- | An abstract type that contains a value for each variant of 'IOError'.
data IOErrorType
@@
-857,13
+858,13
@@
instance Show IOErrorType where
-- > fail s = ioError (userError s)
--
userError :: String -> IOError
-- > fail s = ioError (userError s)
--
userError :: String -> IOError
-userError str = IOError Nothing UserError "" str Nothing
+userError str = IOError Nothing UserError "" str Nothing Nothing
-- ---------------------------------------------------------------------------
-- Showing IOErrors
instance Show IOException where
-- ---------------------------------------------------------------------------
-- Showing IOErrors
instance Show IOException where
- showsPrec p (IOError hdl iot loc s fn) =
+ showsPrec p (IOError hdl iot loc s _ fn) =
(case fn of
Nothing -> case hdl of
Nothing -> id
(case fn of
Nothing -> case hdl of
Nothing -> id
diff --git
a/System/Environment.hs
b/System/Environment.hs
index
4b32987
..
c734158
100644
(file)
--- a/
System/Environment.hs
+++ b/
System/Environment.hs
@@
-123,7
+123,7
@@
getEnv name =
if litstring /= nullPtr
then peekCString litstring
else ioException (IOError Nothing NoSuchThing "getEnv"
if litstring /= nullPtr
then peekCString litstring
else ioException (IOError Nothing NoSuchThing "getEnv"
- "no environment variable" (Just name))
+ "no environment variable" Nothing (Just name))
foreign import ccall unsafe "getenv"
c_getenv :: CString -> IO (Ptr CChar)
foreign import ccall unsafe "getenv"
c_getenv :: CString -> IO (Ptr CChar)
diff --git
a/System/Exit.hs
b/System/Exit.hs
index
e211ca5
..
f4fbac5
100644
(file)
--- a/
System/Exit.hs
+++ b/
System/Exit.hs
@@
-64,7
+64,7
@@
exitWith ExitSuccess = throwIO ExitSuccess
exitWith code@(ExitFailure n)
| n /= 0 = throwIO code
#ifdef __GLASGOW_HASKELL__
exitWith code@(ExitFailure n)
| n /= 0 = throwIO code
#ifdef __GLASGOW_HASKELL__
- | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing)
+ | otherwise = ioError (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0" Nothing Nothing)
#endif
#endif /* ! __NHC__ */
#endif
#endif /* ! __NHC__ */
diff --git
a/System/IO/Error.hs
b/System/IO/Error.hs
index
0313d7b
..
fcbffad
100644
(file)
--- a/
System/IO/Error.hs
+++ b/
System/IO/Error.hs
@@
-155,6
+155,9
@@
mkIOError t location maybe_hdl maybe_filename =
IOError{ ioe_type = t,
ioe_location = location,
ioe_description = "",
IOError{ ioe_type = t,
ioe_location = location,
ioe_description = "",
+#if defined(__GLASGOW_HASKELL__)
+ ioe_errno = Nothing,
+#endif
ioe_handle = maybe_hdl,
ioe_filename = maybe_filename
}
ioe_handle = maybe_hdl,
ioe_filename = maybe_filename
}
@@
-370,8
+373,9
@@
annotateIOError :: IOError
-> Maybe Handle
-> Maybe FilePath
-> IOError
-> Maybe Handle
-> Maybe FilePath
-> IOError
-annotateIOError (IOError ohdl errTy _ str opath) loc hdl path =
- IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath)
+annotateIOError ioe loc hdl path =
+ ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
+ ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
where
Nothing `mplus` ys = ys
xs `mplus` _ = xs
where
Nothing `mplus` ys = ys
xs `mplus` _ = xs
diff --git
a/System/Posix/Internals.hs
b/System/Posix/Internals.hs
index
1a9f845
..
ebd9ec9
100644
(file)
--- a/
System/Posix/Internals.hs
+++ b/
System/Posix/Internals.hs
@@
-129,7
+129,11
@@
statGetType p_stat = do
ioe_unknownfiletype :: IOException
ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
ioe_unknownfiletype :: IOException
ioe_unknownfiletype = IOError Nothing UnsupportedOperation "fdType"
- "unknown file type" Nothing
+ "unknown file type"
+#if __GLASGOW_HASKELL__
+ Nothing
+#endif
+ Nothing
#if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__))
closeFd :: Bool -> CInt -> IO CInt
#if __GLASGOW_HASKELL__ && (defined(mingw32_HOST_OS) || defined(__MINGW32__))
closeFd :: Bool -> CInt -> IO CInt