Commit 2a83a2aa authored by Ian Lynagh's avatar Ian Lynagh

Handle errors in an OPTIONS pragma when preprocessing

parent a7f88c2f
......@@ -1213,17 +1213,6 @@ mk_pvm_wrapper_script pvm_executable pvm_executable_base sysMan = unlines $
"exit($return_val);"
]
-----------------------------------------------------------------------------
-- 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
......
......@@ -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
......
......@@ -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
......
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