Ensure DynFlags are consistent
authorBen Gamari <bgamari.foss@gmail.com>
Thu, 6 Aug 2015 15:25:46 +0000 (17:25 +0200)
committerBen Gamari <ben@smart-cactus.org>
Thu, 6 Aug 2015 15:25:47 +0000 (17:25 +0200)
While we have always had makeDynFlagsConsistent to enforce a variety of
consistency invariants on DynFlags, it hasn't been widely used.
GHC.Main, for instance, ignored it entirely. This leads to issues like
Trac #10549, where an OPTIONS_GHC pragma introduced an inconsistency,
leading to a perplexing crash later in compilation.

Here I add consistency checks in GHC.Main.set{Session,Program}DynFlags,
closing this hole.

Fixes #10549.

Test Plan: Validate with T10549

Reviewers: austin

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1128

GHC Trac Issues: #10549

compiler/main/DynFlags.hs
compiler/main/GHC.hs
testsuite/tests/ghc-api/T10052/T10052.stderr
testsuite/tests/ghci.debugger/scripts/print007.stderr
testsuite/tests/ghci/should_fail/Makefile [new file with mode: 0644]
testsuite/tests/ghci/should_fail/T10549.hs [new file with mode: 0644]
testsuite/tests/ghci/should_fail/T10549.script [new file with mode: 0644]
testsuite/tests/ghci/should_fail/T10549.stderr [new file with mode: 0644]
testsuite/tests/ghci/should_fail/all.T [new file with mode: 0644]

index 29200c5..4f0bfc5 100644 (file)
@@ -52,7 +52,7 @@ module DynFlags (
         dynFlagDependencies,
         tablesNextToCode, mkTablesNextToCode,
         SigOf, getSigOf,
-        checkOptLevel,
+        makeDynFlagsConsistent,
 
         Way(..), mkBuildTag, wayRTSOnly, addWay', updateWays,
         wayGeneralFlags, wayUnsetGeneralFlags,
@@ -4157,10 +4157,13 @@ tARGET_MAX_WORD dflags
       8 -> toInteger (maxBound :: Word64)
       w -> panic ("tARGET_MAX_WORD: Unknown platformWordSize: " ++ show w)
 
+-- | Resolve any internal inconsistencies in a set of 'DynFlags'.
+-- Returns the consistent 'DynFlags' as well as a list of warnings
+-- to report to the user.
+makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
 -- Whenever makeDynFlagsConsistent does anything, it starts over, to
 -- ensure that a later change doesn't invalidate an earlier check.
 -- Be careful not to introduce potential loops!
-makeDynFlagsConsistent :: DynFlags -> (DynFlags, [Located String])
 makeDynFlagsConsistent dflags
  -- Disable -dynamic-too on Windows (#8228, #7134, #5987)
  | os == OSMinGW32 && gopt Opt_BuildDynamicToo dflags
@@ -4199,6 +4202,8 @@ makeDynFlagsConsistent dflags
    not (gopt Opt_PIC dflags)
     = loop (gopt_set dflags Opt_PIC)
            "Enabling -fPIC as it is always on for this platform"
+ | Left err <- checkOptLevel (optLevel dflags) dflags
+    = loop (updOptLevel 0 dflags) err
  | otherwise = (dflags, [])
     where loc = mkGeneralSrcSpan (fsLit "when making flags consistent")
           loop updated_dflags warning
@@ -4208,6 +4213,33 @@ makeDynFlagsConsistent dflags
           arch = platformArch platform
           os   = platformOS   platform
 
+{-
+Note [DynFlags consistency]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+There are a number of number of DynFlags configurations which either
+do not make sense or lead to unimplemented or buggy codepaths in the
+compiler. makeDynFlagsConsistent is responsible for verifying the validity
+of a set of DynFlags, fixing any issues, and reporting them back to the
+caller.
+
+GHCi and -O
+---------------
+
+When using optimization, the compiler can introduce several things
+(such as unboxed tuples) into the intermediate code, which GHCi later
+chokes on since the bytecode interpreter can't handle this (and while
+this is arguably a bug these aren't handled, there are no plans to fix
+it.)
+
+While the driver pipeline always checks for this particular erroneous
+combination when parsing flags, we also need to check when we update
+the flags; this is because API clients may parse flags but update the
+DynFlags afterwords, before finally running code inside a session (see
+T10052 and #10052).
+
+-}
+
 --------------------------------------------------------------------------
 -- Do not use unsafeGlobalDynFlags!
 --
index d9380e1..4b72098 100644 (file)
@@ -635,32 +635,15 @@ parseDynamicFlags :: MonadIO m =>
                   -> m (DynFlags, [Located String], [Located String])
 parseDynamicFlags = parseDynamicFlagsCmdLine
 
-{- Note [GHCi and -O]
-~~~~~~~~~~~~~~~~~~~~~
-When using optimization, the compiler can introduce several things
-(such as unboxed tuples) into the intermediate code, which GHCi later
-chokes on since the bytecode interpreter can't handle this (and while
-this is arguably a bug these aren't handled, there are no plans to fix
-it.)
-
-While the driver pipeline always checks for this particular erroneous
-combination when parsing flags, we also need to check when we update
-the flags; this is because API clients may parse flags but update the
-DynFlags afterwords, before finally running code inside a session (see
-T10052 and #10052).
--}
-
 -- | Checks the set of new DynFlags for possibly erroneous option
 -- combinations when invoking 'setSessionDynFlags' and friends, and if
 -- found, returns a fixed copy (if possible).
 checkNewDynFlags :: MonadIO m => DynFlags -> m DynFlags
-checkNewDynFlags dflags
-  -- See Note [GHCi and -O]
-  | Left e <- checkOptLevel (optLevel dflags) dflags
-    = do liftIO $ warningMsg dflags (text e)
-         return (dflags { optLevel = 0 })
-  | otherwise
-    = return dflags
+checkNewDynFlags dflags = do
+  -- See Note [DynFlags consistency]
+  let (dflags', warnings) = makeDynFlagsConsistent dflags
+  liftIO $ handleFlagWarnings dflags warnings
+  return dflags'
 
 -- %************************************************************************
 -- %*                                                                      *
index d298a59..62f0b6d 100644 (file)
@@ -1,3 +1,3 @@
 
-<no location info>: Warning:
+when making flags consistent: warning:
     -O conflicts with --interactive; -O ignored.
index 0debeb4..62f0b6d 100644 (file)
@@ -1,6 +1,3 @@
 
-<no location info>: warning:
-    -O conflicts with --interactive; -O ignored.
-
-<no location info>: warning:
+when making flags consistent: warning:
     -O conflicts with --interactive; -O ignored.
diff --git a/testsuite/tests/ghci/should_fail/Makefile b/testsuite/tests/ghci/should_fail/Makefile
new file mode 100644 (file)
index 0000000..9101fbd
--- /dev/null
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/ghci/should_fail/T10549.hs b/testsuite/tests/ghci/should_fail/T10549.hs
new file mode 100644 (file)
index 0000000..2c8d714
--- /dev/null
@@ -0,0 +1,15 @@
+{-# OPTIONS_GHC -O2 #-}
+
+-- Verify that -O2 is rejected when this module is loaded by GHCi
+module T10549 where
+
+import qualified Data.ByteString.Internal as Internal
+import System.IO.Unsafe (unsafePerformIO)
+import Data.Word (Word8)
+import Foreign.Ptr (Ptr)
+import Foreign.Storable (peek)
+
+type S = Ptr Word8
+
+chr :: S -> Char
+chr x = Internal.w2c $ unsafePerformIO $ peek x
diff --git a/testsuite/tests/ghci/should_fail/T10549.script b/testsuite/tests/ghci/should_fail/T10549.script
new file mode 100644 (file)
index 0000000..432eccb
--- /dev/null
@@ -0,0 +1 @@
+:load T10549.hs
diff --git a/testsuite/tests/ghci/should_fail/T10549.stderr b/testsuite/tests/ghci/should_fail/T10549.stderr
new file mode 100644 (file)
index 0000000..1f49f8e
--- /dev/null
@@ -0,0 +1,3 @@
+
+when making flags consistent: Warning:
+    -O conflicts with --interactive; -O ignored.
diff --git a/testsuite/tests/ghci/should_fail/all.T b/testsuite/tests/ghci/should_fail/all.T
new file mode 100644 (file)
index 0000000..cb46ac2
--- /dev/null
@@ -0,0 +1,3 @@
+setTestOpts(when(compiler_profiled(), skip))
+
+test('T10549', [], ghci_script, ['T10549.script'])