diff options
author | Ian Lynagh <igloo@earth.li> | 2008-06-14 14:58:40 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2008-06-14 14:58:40 +0000 |
commit | 2a83a2aa7b6213e6fc5df909012e272445efd476 (patch) | |
tree | 70f7e2b5713add592b8ccd5b7ddd0af46f519167 /compiler | |
parent | a7f88c2f7900257d6791286f653cf141ebcb81c4 (diff) | |
download | haskell-2a83a2aa7b6213e6fc5df909012e272445efd476.tar.gz |
Handle errors in an OPTIONS pragma when preprocessing
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/main/DriverPipeline.hs | 11 | ||||
-rw-r--r-- | compiler/main/GHC.hs | 6 | ||||
-rw-r--r-- | compiler/main/HeaderInfo.hs | 16 |
3 files changed, 18 insertions, 15 deletions
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index 318dac541c..b9de30626e 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -1214,17 +1214,6 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $ ] ----------------------------------------------------------------------------- --- Complain about non-dynamic flags in OPTIONS pragmas - -checkProcessArgsResult :: [String] -> FilePath -> IO () -checkProcessArgsResult flags filename - = do when (notNull flags) (throwDyn (ProgramError ( - showSDoc (hang (text filename <> char ':') - 4 (text "unknown flags in {-# OPTIONS #-} pragma:" <+> - hsep (map text flags))) - ))) - ------------------------------------------------------------------------------ -- Look for the /* GHC_PACKAGES ... */ comment at the top of a .hc file getHCFilePackages :: FilePath -> IO [PackageId] diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index a629ef2c11..f08b613555 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -239,7 +239,7 @@ import CoreSyn import TidyPgm import DriverPipeline import DriverPhases ( HscSource(..), Phase(..), isHaskellSrcFilename, startPhase ) -import HeaderInfo ( getImports, getOptions ) +import HeaderInfo import Finder import HscMain import HscTypes @@ -1935,8 +1935,8 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) let local_opts = getOptions dflags buf src_fn -- - (dflags', _errs, warns) <- parseDynamicFlags dflags (map unLoc local_opts) - -- XXX: shouldn't we be reporting the errors? + (dflags', leftovers, warns) <- parseDynamicFlags dflags (map unLoc local_opts) + checkProcessArgsResult leftovers src_fn handleFlagWarnings dflags' warns let diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 9b92308eaf..10f714b04d 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -17,7 +17,8 @@ module HeaderInfo ( getImports , getOptionsFromFile, getOptions - , optionsErrorMsgs ) where + , optionsErrorMsgs, + checkProcessArgsResult ) where #include "HsVersions.h" @@ -186,6 +187,19 @@ getOptions' dflags buf filename POk state' t -> (buffer state,t):lexAll state' _ -> [(buffer state,L (last_loc state) ITeof)] +----------------------------------------------------------------------------- +-- Complain about non-dynamic flags in OPTIONS pragmas + +checkProcessArgsResult :: [String] -> FilePath -> IO () +checkProcessArgsResult flags filename + = do when (notNull flags) (throwDyn (ProgramError ( + showSDoc (hang (text filename <> char ':') + 4 (text "unknown flags in {-# OPTIONS #-} pragma:" <+> + hsep (map text flags))) + ))) + +----------------------------------------------------------------------------- + checkExtension :: Located FastString -> Located String checkExtension (L l ext) -- Checks if a given extension is valid, and if so returns |