close the temporary Handle before removing the file

[ghc-hetmet.git] / utils / runghc / runghc.hs

diff --git a/utils/runghc/runghc.hs b/utils/runghc/runghc.hs
index 5053858..5baaeff 100644 (file)
--- a/utils/runghc/runghc.hs
+++ b/utils/runghc/runghc.hs
@@ -32,6 +32,12 @@ import System.Exit
 import System.FilePath
 import System.IO
 
+#if defined(mingw32_HOST_OS)
+import Control.Monad
+import Foreign
+import Foreign.C.String
+#endif
+
 main :: IO ()
 main = do
     args <- getArgs
@@ -51,8 +57,8 @@ getGhcLoc args = case args of
                  ('-' : 'f' : ghc) : args' -> f ghc args'
                  -- If you need the first GHC flag to be a -f flag then
                  -- you can pass -- first
-                 "--" : args -> (Nothing, args)
-                 args        -> (Nothing, args)
+                 "--" : args' -> (Nothing, args')
+                 _            -> (Nothing, args)
     where f ghc args' = -- If there is another -f flag later on then
                         -- that overrules the one that we've already
                         -- found
@@ -70,15 +76,22 @@ doIt ghc args = do
            tmpdir <- getTemporaryDirectory
            bracket
              (openTempFile tmpdir "runghcXXXX.hs")
-             (\(filename,_) -> removeFile filename)
+             (\(filename,h) -> do hClose h; removeFile filename)
              $ \(filename,h) -> do
                  getContents >>= hPutStr h
                  hClose h
                  doIt ghc (ghc_args ++ [filename])
         filename : prog_args -> do
-            let xflag = if takeExtension filename == ".lhs"
-                        then []
-                        else ["-x", "hs"]
+            -- If the file exists, and is not a .lhs file, then we
+            -- want to treat it as a .hs file.
+            --
+            -- If the file doesn't exist then GHC is going to look for
+            -- filename.hs and filename.lhs, and use the appropriate
+            -- type.
+            exists <- doesFileExist filename
+            let xflag = if exists && (takeExtension filename /= ".lhs")
+                        then ["-x", "hs"]
+                        else []
                 c1 = ":set prog " ++ show filename
                 c2 = ":main " ++ show prog_args
             res <- rawSystem ghc (["-ignore-dot-ghci"] ++