Commit ef3da13b authored by sof's avatar sof
Browse files

[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
parent acc784b5
-----------------------------------------------------------------------------
-- $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)
......
-----------------------------------------------------------------------------
-- $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
......@@ -68,6 +68,13 @@ softGetDirectoryContents d
return []
)
-----------------------------------------------------------------------------
-- 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
......@@ -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)
......
{-# 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).
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment