From ef3da13ba529e1f0202709bec93a2b5ba7f3e1b8 Mon Sep 17 00:00:00 2001 From: sof Date: Fri, 5 Apr 2002 16:43:56 +0000 Subject: [PATCH] [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 --- ghc/compiler/main/DriverState.hs | 33 ++++++++++++++++++++++++++++++++- ghc/compiler/main/DriverUtil.hs | 14 ++++++++++++-- ghc/compiler/main/Main.hs | 23 +++++++++++++++++------ 3 files changed, 61 insertions(+), 9 deletions(-) diff --git a/ghc/compiler/main/DriverState.hs b/ghc/compiler/main/DriverState.hs index 6d15663..b8684fe 100644 --- 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 --- 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 --- 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). + -- 1.7.10.4