diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs index 12d1e8706aac238f4a02123af38671e4f50a1cde..577da56c5eaa8d10d34fab7e1a691fb006af5c2c 100644 --- a/ghc/lib/std/CPUTime.lhs +++ b/ghc/lib/std/CPUTime.lhs @@ -43,8 +43,8 @@ getCPUTime = fromIntegral (I# (indexIntArray# frozen# 2#)) * 1000000000 + fromIntegral (I# (indexIntArray# frozen# 3#))) * 1000) else - fail (IOError Nothing UnsupportedOperation - "getCPUTime: can't get CPU time") + fail (IOError Nothing UnsupportedOperation "getCPUTime" + "can't get CPU time") cpuTimePrecision :: Integer cpuTimePrecision = round ((1000000000000::Integer) % diff --git a/ghc/lib/std/Directory.lhs b/ghc/lib/std/Directory.lhs index 51d20bebc718842b42a664d329fbaa3b7a4b4364..47705ddae2cc7f7ad9cfd61fa23a627ca80a6a47 100644 --- a/ghc/lib/std/Directory.lhs +++ b/ghc/lib/std/Directory.lhs @@ -44,7 +44,7 @@ import PrelIOBase import PrelST import PrelArr import PrelPack ( unpackNBytesST ) -import PrelForeign ( Word(..) ) +import PrelCCall ( Word(..) ) import PrelAddr import Time ( ClockTime(..) ) @@ -259,7 +259,7 @@ renameDirectory opath npath = do if rc == 0 then return () else - constructErrorAndFailWithInfo "renameDirectory" opath + constructErrorAndFailWithInfo "renameDirectory" ("old: " ++ opath ++ ",new: " ++ npath) \end{code} @renameFile old@ {\em new} changes the name of an existing file system @@ -473,7 +473,7 @@ setPermissions name (Permissions r w e s) = do rc <- _ccall_ chmod name mode if rc == 0 then return () - else fail (IOError Nothing SystemError "Directory.setPermissions") + else fail (IOError Nothing SystemError "setPermissions" "insufficient permissions") \end{code} @@ -489,7 +489,7 @@ getFileStatus name = do rc <- _casm_ ``%r = stat(%0,(struct stat *)%1);'' name bytes if rc == 0 then stToIO (unsafeFreezeByteArray bytes) - else fail (IOError Nothing SystemError "Directory.getFileStatus") + else fail (IOError Nothing SystemError "getFileStatus" "") modificationTime :: FileStatus -> IO ClockTime modificationTime stat = do diff --git a/ghc/lib/std/System.lhs b/ghc/lib/std/System.lhs index 192fa29ac49c205c569eec2ff0b163ea3f773087..9fec04ddf68a2411f4aeaaa5f127ab988dceed2a 100644 --- a/ghc/lib/std/System.lhs +++ b/ghc/lib/std/System.lhs @@ -79,7 +79,7 @@ getEnv name = do litstring <- _ccall_ getenv name if litstring /= ``NULL'' then return (unpackCString litstring) - else fail (IOError Nothing NoSuchThing + else fail (IOError Nothing NoSuchThing "getEnv" ("environment variable: " ++ name)) \end{code} @@ -97,7 +97,7 @@ The implementation does not support system calls. \end{itemize} \begin{code} -system "" = fail (IOError Nothing InvalidArgument "null command") +system "" = fail (IOError Nothing InvalidArgument "system" "null command") system cmd = do status <- _ccall_ systemCmd cmd case status of @@ -114,13 +114,13 @@ Before it terminates, any open or semi-closed handles are first closed. \begin{code} exitWith ExitSuccess = do _ccall_ EXIT (0::Int) - fail (IOError Nothing OtherError "exit should not return") + fail (IOError Nothing OtherError "exitWith" "exit should not return") exitWith (ExitFailure n) - | n == 0 = fail (IOError Nothing InvalidArgument "ExitFailure 0") + | n == 0 = fail (IOError Nothing InvalidArgument "exitWith" "ExitFailure 0") | otherwise = do _ccall_ EXIT n - fail (IOError Nothing OtherError "exit should not return") + fail (IOError Nothing OtherError "exitWith" "exit should not return") \end{code}