[commit: ghc] wip/T16197: GHCi ignores cmd line flags XMonomorphismRestr.. XNoExtendedDef..#10857 (9fb744b)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T16197
Link       : http://ghc.haskell.org/trac/ghc/changeset/9fb744bdc54c75cf5b91aa783b18233ba8da04a6/ghc

>---------------------------------------------------------------

commit 9fb744bdc54c75cf5b91aa783b18233ba8da04a6
Author: Roland Senn <rsx at bluewin.ch>
Date:   Mon Dec 24 14:14:25 2018 +0100

    GHCi ignores cmd line flags XMonomorphismRestr.. XNoExtendedDef..#10857


>---------------------------------------------------------------

9fb744bdc54c75cf5b91aa783b18233ba8da04a6
 compiler/main/DynFlags.hs                      | 17 +++++++++++++++++
 ghc/GHCi/UI.hs                                 | 12 ++++++++++--
 testsuite/tests/ghci/should_run/T10857a.script |  1 +
 testsuite/tests/ghci/should_run/T10857a.stdout |  6 ++++++
 testsuite/tests/ghci/should_run/T10857b.script |  1 +
 testsuite/tests/ghci/should_run/T10857b.stdout |  4 ++++
 testsuite/tests/ghci/should_run/all.T          |  4 ++++
 7 files changed, 43 insertions(+), 2 deletions(-)

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 7296809..ccc2a05 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -34,6 +34,7 @@ module DynFlags (
         wopt, wopt_set, wopt_unset,
         wopt_fatal, wopt_set_fatal, wopt_unset_fatal,
         xopt, xopt_set, xopt_unset,
+        xopt_set_unlessExplSpec,
         lang_set,
         useUnicodeSyntax,
         useStarIsType,
@@ -1077,6 +1078,9 @@ data DynFlags = DynFlags {
   warnUnsafeOnLoc       :: SrcSpan,
   trustworthyOnLoc      :: SrcSpan,
   -- Don't change this without updating extensionFlags:
+  -- Here we collect the settings of the language extensions
+  -- from the command line, the ghci config file and
+  -- from interactive :set / :seti commands.
   extensions            :: [OnOff LangExt.Extension],
   -- extensionFlags should always be equal to
   --     flattenExtensionFlags language extensions
@@ -2378,6 +2382,19 @@ xopt_unset dfs f
       in dfs { extensions = onoffs,
                extensionFlags = flattenExtensionFlags (language dfs) onoffs }
 
+-- | Set or unset a 'LangExt.Extension', unless it has been explicitely
+--   set or unset before.
+xopt_set_unlessExplSpec
+        :: LangExt.Extension
+        -> (DynFlags -> LangExt.Extension -> DynFlags)
+        -> DynFlags -> DynFlags
+xopt_set_unlessExplSpec ext setUnset dflags =
+    let referedExts = stripOnOff <$> extensions dflags
+        stripOnOff (On x)  = x
+        stripOnOff (Off x) = x
+    in
+        if ext `elem` referedExts then dflags else setUnset dflags ext
+
 lang_set :: DynFlags -> Maybe Language -> DynFlags
 lang_set dflags lang =
    dflags {
diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs
index d6d86fc..3a26dfe 100644
--- a/ghc/GHCi/UI.hs
+++ b/ghc/GHCi/UI.hs
@@ -433,9 +433,17 @@ interactiveUI config srcs maybe_exprs = do
    -- The initial set of DynFlags used for interactive evaluation is the same
    -- as the global DynFlags, plus -XExtendedDefaultRules and
    -- -XNoMonomorphismRestriction.
+   -- However we set/unset these two extensions only, if they were not already
+   -- explicitely specified before. The function 'xopt_set_unlessExplSpec'
+   -- inspects the data field DynFlags.extensions.
+   -- At this point of the GHCi initialization this data field contains only
+   -- the extensions specified at the command line.
+   -- The ghci config file has not yet been processed. (#10857)
    dflags <- getDynFlags
-   let dflags' = (`xopt_set` LangExt.ExtendedDefaultRules)
-               . (`xopt_unset` LangExt.MonomorphismRestriction)
+   let dflags' = (xopt_set_unlessExplSpec
+                      LangExt.ExtendedDefaultRules xopt_set)
+               . (xopt_set_unlessExplSpec
+                      LangExt.MonomorphismRestriction xopt_unset)
                $ dflags
    GHC.setInteractiveDynFlags dflags'
 
diff --git a/testsuite/tests/ghci/should_run/T10857a.script b/testsuite/tests/ghci/should_run/T10857a.script
new file mode 100644
index 0000000..d0b4977
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T10857a.script
@@ -0,0 +1 @@
+:showi lang
diff --git a/testsuite/tests/ghci/should_run/T10857a.stdout b/testsuite/tests/ghci/should_run/T10857a.stdout
new file mode 100644
index 0000000..a37151f
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T10857a.stdout
@@ -0,0 +1,6 @@
+base language is: Haskell2010
+with the following modifiers:
+  -XNoDatatypeContexts
+  -XExtendedDefaultRules
+  -XNoMonomorphismRestriction
+  -XNondecreasingIndentation
diff --git a/testsuite/tests/ghci/should_run/T10857b.script b/testsuite/tests/ghci/should_run/T10857b.script
new file mode 100644
index 0000000..d0b4977
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T10857b.script
@@ -0,0 +1 @@
+:showi lang
diff --git a/testsuite/tests/ghci/should_run/T10857b.stdout b/testsuite/tests/ghci/should_run/T10857b.stdout
new file mode 100644
index 0000000..2619fae
--- /dev/null
+++ b/testsuite/tests/ghci/should_run/T10857b.stdout
@@ -0,0 +1,4 @@
+base language is: Haskell2010
+with the following modifiers:
+  -XNoDatatypeContexts
+  -XNondecreasingIndentation
diff --git a/testsuite/tests/ghci/should_run/all.T b/testsuite/tests/ghci/should_run/all.T
index 004794b..a9eded4 100644
--- a/testsuite/tests/ghci/should_run/all.T
+++ b/testsuite/tests/ghci/should_run/all.T
@@ -23,6 +23,10 @@ test('T9914',      just_ghci, ghci_script, ['T9914.script'])
 test('T9915',      just_ghci, ghci_script, ['T9915.script'])
 test('T10145',     just_ghci, ghci_script, ['T10145.script'])
 test('T7253',      just_ghci, ghci_script, ['T7253.script'])
+test('T10857a',    just_ghci, ghci_script, ['T10857a.script'])
+test('T10857b',
+      [extra_hc_opts("-XMonomorphismRestriction -XNoExtendedDefaultRules")],
+                   ghci_script, ['T10857b.script'])
 test('T11328',     just_ghci, ghci_script, ['T11328.script'])
 test('T11825',     just_ghci, ghci_script, ['T11825.script'])
 test('T12128',     just_ghci, ghci_script, ['T12128.script'])