diff options
author | Aaron Allen <aaron@flipstone.com> | 2021-05-04 21:35:11 -0500 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-05-06 12:44:43 -0400 |
commit | 0281dae8b3fe3384939c415ae72ca2440b3cafb3 (patch) | |
tree | e4dd89beaa5ba386fd11d719ea15d1f4bde35cea | |
parent | 87d8c008eeb8ff733ac0bfcfdbb0f1a758a417b9 (diff) | |
download | haskell-0281dae8b3fe3384939c415ae72ca2440b3cafb3.tar.gz |
Disallow -XDerivingVia when -XSafe is on (#19786)
Since `GeneralizedNewtypeDeriving` is considered unsafe, `DerivingVia`
should be as well.
-rw-r--r-- | compiler/GHC/Driver/Session.hs | 12 | ||||
-rw-r--r-- | testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/safeHaskell/safeLanguage/all.T | 1 |
4 files changed, 23 insertions, 1 deletions
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs index c2d1bed546..2673840100 100644 --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -592,6 +592,7 @@ data DynFlags = DynFlags { -- them. thOnLoc :: SrcSpan, newDerivOnLoc :: SrcSpan, + deriveViaOnLoc :: SrcSpan, overlapInstLoc :: SrcSpan, incoherentOnLoc :: SrcSpan, pkgTrustOnLoc :: SrcSpan, @@ -1201,6 +1202,7 @@ defaultDynFlags mySettings llvmConfig = safeInferred = True, thOnLoc = noSrcSpan, newDerivOnLoc = noSrcSpan, + deriveViaOnLoc = noSrcSpan, overlapInstLoc = noSrcSpan, incoherentOnLoc = noSrcSpan, pkgTrustOnLoc = noSrcSpan, @@ -1619,6 +1621,9 @@ unsafeFlags, unsafeFlagsForInfer unsafeFlags = [ ("-XGeneralizedNewtypeDeriving", newDerivOnLoc, xopt LangExt.GeneralizedNewtypeDeriving, flip xopt_unset LangExt.GeneralizedNewtypeDeriving) + , ("-XDerivingVia", deriveViaOnLoc, + xopt LangExt.DerivingVia, + flip xopt_unset LangExt.DerivingVia) , ("-XTemplateHaskell", thOnLoc, xopt LangExt.TemplateHaskell, flip xopt_unset LangExt.TemplateHaskell) @@ -3494,7 +3499,8 @@ xFlagsDeps = [ flagSpec "DeriveLift" LangExt.DeriveLift, flagSpec "DeriveTraversable" LangExt.DeriveTraversable, flagSpec "DerivingStrategies" LangExt.DerivingStrategies, - flagSpec "DerivingVia" LangExt.DerivingVia, + flagSpec' "DerivingVia" LangExt.DerivingVia + setDeriveVia, flagSpec "DisambiguateRecordFields" LangExt.DisambiguateRecordFields, flagSpec "DoAndIfThenElse" LangExt.DoAndIfThenElse, flagSpec "BlockArguments" LangExt.BlockArguments, @@ -4093,6 +4099,10 @@ setGenDeriving :: TurnOnFlag -> DynP () setGenDeriving True = getCurLoc >>= \l -> upd (\d -> d { newDerivOnLoc = l }) setGenDeriving False = return () +setDeriveVia :: TurnOnFlag -> DynP () +setDeriveVia True = getCurLoc >>= \l -> upd (\d -> d { deriveViaOnLoc = l }) +setDeriveVia False = return () + setOverlappingInsts :: TurnOnFlag -> DynP () setOverlappingInsts False = return () setOverlappingInsts True = do diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs new file mode 100644 index 0000000000..915876a838 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE Haskell2010 #-} +{-# LANGUAGE Safe, DerivingVia #-} + +-- | Tests that Safe disables DerivingVia (#19786) +module SafeLang19 where + +f :: Int +f = 1 diff --git a/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr new file mode 100644 index 0000000000..1dbe65d156 --- /dev/null +++ b/testsuite/tests/safeHaskell/safeLanguage/SafeLang19.stderr @@ -0,0 +1,3 @@ + +SafeLang19.hs:2:20: warning: + -XDerivingVia is not allowed in Safe Haskell; ignoring -XDerivingVia diff --git a/testsuite/tests/safeHaskell/safeLanguage/all.T b/testsuite/tests/safeHaskell/safeLanguage/all.T index de4a9b6908..ac15d88a21 100644 --- a/testsuite/tests/safeHaskell/safeLanguage/all.T +++ b/testsuite/tests/safeHaskell/safeLanguage/all.T @@ -32,6 +32,7 @@ test('SafeLang16', normal, compile, ['']) test('SafeLang17', [], multimod_compile_fail, ['SafeLang17', '']) test('SafeLang18', normal, compile, ['']) +test('SafeLang19', normal, compile, ['']) # Test building a package, that trust values are set correctly # and can be changed correctly |