Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Alexis King
GHC
Commits
82e19ffc
Commit
82e19ffc
authored
Dec 19, 2011
by
dterei
Browse files
Ignore -fpackage-trust if no other Safe Haskell flags
parent
c779a713
Changes
1
Hide whitespace changes
Inline
Side-by-side
compiler/main/DynFlags.hs
View file @
82e19ffc
...
...
@@ -564,11 +564,12 @@ data DynFlags = DynFlags {
language
::
Maybe
Language
,
-- | Safe Haskell mode
safeHaskell
::
SafeHaskellMode
,
-- We store the location of where
template haskell and newtype deriving were
--
turned on so
we can produce accurate error messages when Safe Haskell
turns
-- them
off
.
-- We store the location of where
some extension and flags were turned on so
-- we can produce accurate error messages when Safe Haskell
fails due to
-- them.
thOnLoc
::
SrcSpan
,
newDerivOnLoc
::
SrcSpan
,
pkgTrustOnLoc
::
SrcSpan
,
warnSafeOnLoc
::
SrcSpan
,
warnUnsafeOnLoc
::
SrcSpan
,
-- Don't change this without updating extensionFlags:
...
...
@@ -911,6 +912,7 @@ defaultDynFlags mySettings =
safeHaskell
=
Sf_SafeInfered
,
thOnLoc
=
noSrcSpan
,
newDerivOnLoc
=
noSrcSpan
,
pkgTrustOnLoc
=
noSrcSpan
,
warnSafeOnLoc
=
noSrcSpan
,
warnUnsafeOnLoc
=
noSrcSpan
,
extensions
=
[]
,
...
...
@@ -1306,19 +1308,28 @@ parseDynamicFlags dflags0 args cmdline = do
when
(
not
(
null
errs
))
$
ghcError
$
errorsToGhcException
errs
-- check for disabled flags in safe haskell
let
(
dflags2
,
sh_warns
)
=
safeFlagCheck
dflags1
let
(
dflags2
,
sh_warns
)
=
safeFlagCheck
cmdline
dflags1
return
(
dflags2
,
leftover
,
sh_warns
++
warns
)
-- | Check (and potentially disable) any extensions that aren't allowed
-- in safe mode.
safeFlagCheck
::
DynFlags
->
(
DynFlags
,
[
Located
String
])
safeFlagCheck
dflags
|
not
(
safeLanguageOn
dflags
||
safeInferOn
dflags
)
=
(
dflags
,
[]
)
safeFlagCheck
dflags
=
safeFlagCheck
::
Bool
->
DynFlags
->
(
DynFlags
,
[
Located
String
])
safeFlagCheck
_
dflags
|
not
(
safeLanguageOn
dflags
||
safeInferOn
dflags
)
=
(
dflags
,
[]
)
safeFlagCheck
cmdl
dflags
=
case
safeLanguageOn
dflags
of
True
->
(
dflags'
,
warns
)
-- throw error if -fpackage-trust by itself with no safe haskell flag
False
|
not
cmdl
&&
safeInferOn
dflags
&&
packageTrustOn
dflags
->
(
dopt_unset
dflags'
Opt_PackageTrust
,
[
L
(
pkgTrustOnLoc
dflags'
)
$
"Warning: -fpackage-trust ignored;"
++
" must be specified with a Safe Haskell flag"
]
)
False
|
null
warns
&&
safeInfOk
->
(
dflags'
,
[]
)
...
...
@@ -1664,7 +1675,7 @@ dynamic_flags = [
,
Flag
"fno-glasgow-exts"
(
NoArg
(
disableGlasgowExts
>>
deprecate
"Use individual extensions instead"
))
------ Safe Haskell flags -------------------------------------------
,
Flag
"fpackage-trust"
(
NoArg
(
set
DynFlag
Opt_
PackageTrust
)
)
,
Flag
"fpackage-trust"
(
NoArg
setPackageTrust
)
,
Flag
"fno-safe-infer"
(
NoArg
(
setSafeHaskell
Sf_None
))
]
++
map
(
mkFlag
turnOn
"f"
setDynFlag
)
fFlags
...
...
@@ -2177,6 +2188,12 @@ setWarnUnsafe :: Bool -> DynP ()
setWarnUnsafe
True
=
getCurLoc
>>=
\
l
->
upd
(
\
d
->
d
{
warnUnsafeOnLoc
=
l
})
setWarnUnsafe
False
=
return
()
setPackageTrust
::
DynP
()
setPackageTrust
=
do
setDynFlag
Opt_PackageTrust
l
<-
getCurLoc
upd
$
\
d
->
d
{
pkgTrustOnLoc
=
l
}
setGenDeriving
::
Bool
->
DynP
()
setGenDeriving
True
=
getCurLoc
>>=
\
l
->
upd
(
\
d
->
d
{
newDerivOnLoc
=
l
})
setGenDeriving
False
=
return
()
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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