Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
2a83a2aa
Commit
2a83a2aa
authored
Jun 14, 2008
by
Ian Lynagh
Browse files
Handle errors in an OPTIONS pragma when preprocessing
parent
a7f88c2f
Changes
3
Hide whitespace changes
Inline
Side-by-side
compiler/main/DriverPipeline.hs
View file @
2a83a2aa
...
...
@@ -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
...
...
compiler/main/GHC.hs
View file @
2a83a2aa
...
...
@@ -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'
,
_er
rs
,
warns
)
<-
parseDynamicFlags
dflags
(
map
unLoc
local_opts
)
-- XXX: shouldn't we be reporting the errors?
(
dflags'
,
leftove
rs
,
warns
)
<-
parseDynamicFlags
dflags
(
map
unLoc
local_opts
)
checkProcessArgsResult
leftovers
src_fn
handleFlagWarnings
dflags'
warns
let
...
...
compiler/main/HeaderInfo.hs
View file @
2a83a2aa
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment