summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2008-06-14 14:58:40 +0000
committerIan Lynagh <igloo@earth.li>2008-06-14 14:58:40 +0000
commit2a83a2aa7b6213e6fc5df909012e272445efd476 (patch)
tree70f7e2b5713add592b8ccd5b7ddd0af46f519167 /compiler
parenta7f88c2f7900257d6791286f653cf141ebcb81c4 (diff)
downloadhaskell-2a83a2aa7b6213e6fc5df909012e272445efd476.tar.gz
Handle errors in an OPTIONS pragma when preprocessing
Diffstat (limited to 'compiler')
-rw-r--r--compiler/main/DriverPipeline.hs11
-rw-r--r--compiler/main/GHC.hs6
-rw-r--r--compiler/main/HeaderInfo.hs16
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