From 091944e3aec736b440a9c1204f152004e382c967 Mon Sep 17 00:00:00 2001
From: Austin Seipp <austin@well-typed.com>
Date: Tue, 19 May 2015 01:56:48 -0500
Subject: compiler: make sure we reject -O + HscInterpreted

When using GHCi, we explicitly reject optimization, because the
compilers optimization passes can introduce unboxed tuples, which the
interpreter is not able to handle. But this goes the other way too: using
GHCi on optimized code may cause the optimizer to float out breakpoints
that the interpreter introduces. This manifests itself in weird ways,
particularly if you as an API client use custom DynFlags to introduce
optimization in combination with HscInterpreted.

It turns out we weren't checking for consistent DynFlag settings when
doing `setSessionDynFlags`, as #10052 showed. While the main driver
handled it in `DynFlags` via `parseDynamicFlags`, we didn't check this
elsewhere.

This does a little refactoring to split out some of the common code, and
immunizes the various `DynFlags` utilities in the `GHC` module from this
particular bug. We should probably be checking other general invariants
too.

This fixes #10052, and adds some notes about the behavior in `GHC` and
`FloatOut`

As a bonus, expose `warningMsg` from `ErrUtils` as a helper since it
didn't exist (somehow).

Signed-off-by: Austin Seipp <austin@well-typed.com>

Reviewed By: edsko

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

GHC Trac Issues: #10052
---
 testsuite/tests/ghc-api/T10052/Makefile        | 12 +++++++++++
 testsuite/tests/ghc-api/T10052/T10052-input.hs |  1 +
 testsuite/tests/ghc-api/T10052/T10052.hs       | 30 ++++++++++++++++++++++++++
 testsuite/tests/ghc-api/T10052/T10052.stderr   |  3 +++
 testsuite/tests/ghc-api/T10052/T10052.stdout   |  1 +
 testsuite/tests/ghc-api/T10052/all.T           |  2 ++
 6 files changed, 49 insertions(+)
 create mode 100644 testsuite/tests/ghc-api/T10052/Makefile
 create mode 100644 testsuite/tests/ghc-api/T10052/T10052-input.hs
 create mode 100644 testsuite/tests/ghc-api/T10052/T10052.hs
 create mode 100644 testsuite/tests/ghc-api/T10052/T10052.stderr
 create mode 100644 testsuite/tests/ghc-api/T10052/T10052.stdout
 create mode 100644 testsuite/tests/ghc-api/T10052/all.T

(limited to 'testsuite/tests/ghc-api')

diff --git a/testsuite/tests/ghc-api/T10052/Makefile b/testsuite/tests/ghc-api/T10052/Makefile
new file mode 100644
index 0000000000..a94ec4ed39
--- /dev/null
+++ b/testsuite/tests/ghc-api/T10052/Makefile
@@ -0,0 +1,12 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+clean:
+	rm -f *.o *.hi
+
+T10052: clean
+	'$(TEST_HC)' $(TEST_HC_OPTS) --make -v0 -package ghc T10052
+	./T10052 "`'$(TEST_HC)' $(TEST_HC_OPTS) --print-libdir | tr -d '\r'`" -XScopedTypeVariables -O
+
+.PHONY: clean T10052
diff --git a/testsuite/tests/ghc-api/T10052/T10052-input.hs b/testsuite/tests/ghc-api/T10052/T10052-input.hs
new file mode 100644
index 0000000000..89879a7195
--- /dev/null
+++ b/testsuite/tests/ghc-api/T10052/T10052-input.hs
@@ -0,0 +1 @@
+main = let (x :: String) = "hello" in putStrLn x
diff --git a/testsuite/tests/ghc-api/T10052/T10052.hs b/testsuite/tests/ghc-api/T10052/T10052.hs
new file mode 100644
index 0000000000..c2df4ae983
--- /dev/null
+++ b/testsuite/tests/ghc-api/T10052/T10052.hs
@@ -0,0 +1,30 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -Wall #-}
+module Main where
+
+import System.Environment
+import GHC
+
+main :: IO ()
+main = do
+    flags <- getArgs
+    runGhc' flags $ do
+      setTargets [Target (TargetFile "T10052-input.hs" Nothing) True Nothing]
+      _success <- load LoadAllTargets
+      return ()
+
+runGhc' :: [String] -> Ghc a -> IO a
+runGhc' args act = do
+    let libdir = head args
+        flags  = tail args
+    (dynFlags, _warns) <- parseStaticFlags (map noLoc flags)
+    runGhc (Just libdir) $ do
+      dflags0 <- getSessionDynFlags
+      (dflags1, _leftover, _warns) <- parseDynamicFlags dflags0 dynFlags
+      let dflags2 = dflags1 {
+              hscTarget = HscInterpreted
+            , ghcLink   = LinkInMemory
+            , verbosity = 1
+            }
+      _newPkgs <- setSessionDynFlags dflags2
+      act
diff --git a/testsuite/tests/ghc-api/T10052/T10052.stderr b/testsuite/tests/ghc-api/T10052/T10052.stderr
new file mode 100644
index 0000000000..d298a59365
--- /dev/null
+++ b/testsuite/tests/ghc-api/T10052/T10052.stderr
@@ -0,0 +1,3 @@
+
+<no location info>: Warning:
+    -O conflicts with --interactive; -O ignored.
diff --git a/testsuite/tests/ghc-api/T10052/T10052.stdout b/testsuite/tests/ghc-api/T10052/T10052.stdout
new file mode 100644
index 0000000000..1a909eb36f
--- /dev/null
+++ b/testsuite/tests/ghc-api/T10052/T10052.stdout
@@ -0,0 +1 @@
+[1 of 1] Compiling Main             ( T10052-input.hs, interpreted )
diff --git a/testsuite/tests/ghc-api/T10052/all.T b/testsuite/tests/ghc-api/T10052/all.T
new file mode 100644
index 0000000000..bb73f85fa1
--- /dev/null
+++ b/testsuite/tests/ghc-api/T10052/all.T
@@ -0,0 +1,2 @@
+test('T10052', normal, run_command,
+               ['$MAKE -s --no-print-directory T10052'])
-- 
cgit v1.2.1