[project @ 1998-08-14 12:59:24 by sof]

Generate better IOErrors

diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs
index 12d1e87..577da56 100644 (file)
--- 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 51d20be..47705dd 100644 (file)
--- 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 192fa29..9fec04d 100644 (file)
--- 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}