From 2a83a2aa7b6213e6fc5df909012e272445efd476 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Sat, 14 Jun 2008 14:58:40 +0000
Subject: [PATCH] Handle errors in an OPTIONS pragma when preprocessing

---
 compiler/main/DriverPipeline.hs |   11 -----------
 compiler/main/GHC.hs            |    6 +++---
 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 318dac5..b9de306 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 a629ef2..f08b613 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 9b92308..10f714b 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
-- 
1.7.10.4