[project @ 2002-04-05 16:43:56 by sof]

Catch the use of non-existent output directories &
report this back to the user. By not doing this, we relied
on external tools (such as the linker or assembler) to give
good feedback about this error condition -- this wasn't
the case (cf. GAS on mingw/cygwin.)

To insert more sanity checks of the effective options
(to the batch compiler), use Main.checkOptions

diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs
index 6d15663..b8684fe 100644 (file)
--- a/ghc/compiler/main/DriverState.hs
+++ b/ghc/compiler/main/DriverState.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverState.hs,v 1.74 2002/03/29 21:39:37 sof Exp $
+-- $Id: DriverState.hs,v 1.75 2002/04/05 16:43:56 sof Exp $
 --
 -- Settings for the driver
 --
@@ -27,6 +27,7 @@ import Panic
 import List
 import Char  
 import Monad
+import Maybe     ( fromJust, isJust )
 import Directory ( doesDirectoryExist )
 
 -----------------------------------------------------------------------------
@@ -125,6 +126,36 @@ GLOBAL_VAR(v_Output_dir,  Nothing, Maybe String)
 GLOBAL_VAR(v_Output_file, Nothing, Maybe String)
 GLOBAL_VAR(v_Output_hi,   Nothing, Maybe String)
 
+-- called to verify that the output files & directories
+-- point somewhere valid. 
+--
+-- The assumption is that the directory portion of these output
+-- options will have to exist by the time 'verifyOutputFiles'
+-- is invoked.
+-- 
+verifyOutputFiles :: IO ()
+verifyOutputFiles = do
+  odir <- readIORef v_Output_dir
+  when (isJust odir) $ do
+     let dir = fromJust odir
+     flg <- doesDirectoryExist dir
+     when (not flg) (nonExistentDir "-odir" dir)
+  ofile <- readIORef v_Output_file
+  when (isJust ofile) $ do
+     let fn = fromJust ofile
+     flg <- doesDirNameExist fn
+     when (not flg) (nonExistentDir "-o" fn)
+  ohi <- readIORef v_Output_hi
+  when (isJust ohi) $ do
+     let hi = fromJust ohi
+     flg <- doesDirNameExist hi
+     when (not flg) (nonExistentDir "-ohi" hi)
+ where
+   nonExistentDir flg dir = 
+     throwDyn (CmdLineError ("error: directory portion of " ++ 
+                             show dir ++ " does not exist (used with " ++ 
+                            show flg ++ " option.)"))
+
 GLOBAL_VAR(v_Object_suf,  Nothing, Maybe String)
 GLOBAL_VAR(v_HC_suf,     Nothing, Maybe String)
 GLOBAL_VAR(v_Hi_dir,      Nothing, Maybe String)

diff --git a/ghc/compiler/main/DriverUtil.hs b/ghc/compiler/main/DriverUtil.hs
index d788dd8..92961ef 100644 (file)
--- a/ghc/compiler/main/DriverUtil.hs
+++ b/ghc/compiler/main/DriverUtil.hs
@@ -1,5 +1,5 @@
 -----------------------------------------------------------------------------
--- $Id: DriverUtil.hs,v 1.31 2002/02/27 16:24:00 simonmar Exp $
+-- $Id: DriverUtil.hs,v 1.32 2002/04/05 16:43:56 sof Exp $
 --
 -- Utils for the driver
 --
@@ -20,7 +20,7 @@ import IOExts
 import Exception
 import Dynamic
 
-import Directory       ( getDirectoryContents )
+import Directory       ( getDirectoryContents, doesDirectoryExist )
 import IO
 import List
 import Char
@@ -69,6 +69,13 @@ softGetDirectoryContents d
          )
 
 -----------------------------------------------------------------------------
+-- Verify that the 'dirname' portion of a FilePath exists.
+-- 
+doesDirNameExist :: FilePath -> IO Bool
+doesDirNameExist fpath = doesDirectoryExist (getdir fpath)
+
+
+-----------------------------------------------------------------------------
 -- Prefixing underscore to linker-level names
 prefixUnderscore :: String -> String
 prefixUnderscore
@@ -81,6 +88,9 @@ prefixUnderscore
 unknownFlagErr :: String -> a
 unknownFlagErr f = throwDyn (UsageError ("unrecognised flag: " ++ f))
 
+unknownFlagsErr :: [String] -> a
+unknownFlagsErr fs = throwDyn (UsageError ("unrecognised flags: " ++ unwords fs))
+
 my_partition :: (a -> Maybe b) -> [a] -> ([(a,b)],[a])
 my_partition _ [] = ([],[])
 my_partition p (a:as)

diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs
index ee84cd0..5d463a6 100644 (file)
--- a/ghc/compiler/main/Main.hs
+++ b/ghc/compiler/main/Main.hs
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.102 2002/03/29 21:39:37 sof Exp $
+-- $Id: Main.hs,v 1.103 2002/04/05 16:43:56 sof Exp $
 --
 -- GHC Driver program
 --
@@ -36,7 +36,7 @@ import DriverState    ( buildCoreToDo, buildStgToDo,
                          v_Cmdline_libraries, v_Keep_tmp_files, v_Ld_inputs,
                          v_OptLevel, v_Output_file, v_Output_hi, 
                          v_Package_details, v_Ways, getPackageExtraGhcOpts,
-                         readPackageConf
+                         readPackageConf, verifyOutputFiles
                        )
 import DriverFlags     ( buildStaticHscOpts,
                          dynamic_flags, processArgs, static_flags)
@@ -45,7 +45,7 @@ import DriverMkDepend ( beginMkDependHS, endMkDependHS )
 import DriverPhases    ( Phase(HsPp, Hsc), haskellish_src_file, objish_file )
 
 import DriverUtil      ( add, handle, handleDyn, later, splitFilename,
-                         unknownFlagErr, getFileSuffix )
+                         unknownFlagsErr, getFileSuffix )
 import CmdLineOpts     ( dynFlag, restoreDynFlags,
                          saveDynFlags, setDynFlags, getDynFlags, dynFlag,
                          DynFlags(..), HscLang(..), v_Static_hsc_opts,
@@ -211,9 +211,9 @@ main =
        -- save the "initial DynFlags" away
    saveDynFlags
 
-       -- complain about any unknown flags
-   mapM unknownFlagErr [ f | f@('-':_) <- srcs ]
-
+        -- perform some checks of the options set / report unknowns.
+   checkOptions srcs
+   
    verb <- dynFlag verbosity
 
        -- Show the GHCi banner
@@ -333,3 +333,14 @@ beginInteractive fileish_args
        state <- cmInit Interactive
        interactiveUI state mods libs
 #endif
+
+checkOptions :: [String] -> IO ()
+checkOptions srcs = do
+     -- complain about any unknown flags
+   let unknown_opts = [ f | f@('-':_) <- srcs ]
+   when (not (null unknown_opts)) (unknownFlagsErr unknown_opts)
+     -- verify that output files point somewhere sensible.
+   verifyOutputFiles
+     -- and anything else that it might be worth checking for
+     -- before kicking of a compilation (pipeline).
+