From 1722fa106e10e63160bb2322e2ccb830fd5b9ab3 Mon Sep 17 00:00:00 2001
From: Richard Eisenberg <eir@cis.upenn.edu>
Date: Tue, 15 Dec 2015 17:36:32 -0500
Subject: Fix #11230.

Previously, we were optimizing away all case expressions over
coercions with dead binders. But sometimes we want to force
the coercion expression. Like when it contains an error.

Test case: typecheck/should_run/T11230
---
 .../indexed-types/should_compile/T7837.stderr      |  3 +++
 testsuite/tests/typecheck/should_run/T11230.hs     | 31 ++++++++++++++++++++++
 testsuite/tests/typecheck/should_run/T11230.stdout |  2 ++
 testsuite/tests/typecheck/should_run/all.T         |  1 +
 4 files changed, 37 insertions(+)
 create mode 100644 testsuite/tests/typecheck/should_run/T11230.hs
 create mode 100644 testsuite/tests/typecheck/should_run/T11230.stdout

(limited to 'testsuite')

diff --git a/testsuite/tests/indexed-types/should_compile/T7837.stderr b/testsuite/tests/indexed-types/should_compile/T7837.stderr
index 838a8fb88e..a4d96b1dfb 100644
--- a/testsuite/tests/indexed-types/should_compile/T7837.stderr
+++ b/testsuite/tests/indexed-types/should_compile/T7837.stderr
@@ -1,3 +1,6 @@
 Rule fired: Class op signum
 Rule fired: Class op abs
 Rule fired: normalize/Double
+Rule fired: Class op HEq_sc
+Rule fired: Class op HEq_sc
+Rule fired: Class op HEq_sc
diff --git a/testsuite/tests/typecheck/should_run/T11230.hs b/testsuite/tests/typecheck/should_run/T11230.hs
new file mode 100644
index 0000000000..769b6ba88e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T11230.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE RoleAnnotations #-}
+{-# OPTIONS_GHC -fdefer-type-errors #-}
+
+module Main where
+
+import Control.Exception
+
+newtype Representational a = Representational ()
+type role Representational representational
+
+newtype Phantom a = Phantom ()
+type role Phantom phantom
+
+testRepresentational :: Representational Char -> Representational Bool
+testRepresentational = id
+{-# NOINLINE testRepresentational #-}
+
+testPhantom :: Phantom Char -> Phantom Bool
+testPhantom = id
+{-# NOINLINE testPhantom #-}
+
+throwsException :: String -> a -> IO ()
+throwsException c v = do
+  result <- try (evaluate v)
+  case result of
+    Right _ -> error (c ++ " (Failure): No exception!")
+    Left (TypeError _) -> putStrLn (c ++ "(Success): exception found")
+
+main = do
+  throwsException "representational" testRepresentational
+  throwsException "phantom" testPhantom
diff --git a/testsuite/tests/typecheck/should_run/T11230.stdout b/testsuite/tests/typecheck/should_run/T11230.stdout
new file mode 100644
index 0000000000..b0ccf012ab
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/T11230.stdout
@@ -0,0 +1,2 @@
+representational(Success): exception found
+phantom(Success): exception found
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index def9ede7ff..1c4f234d19 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -111,3 +111,4 @@ test('T9497c-run', [exit_code(1)], compile_and_run, ['-fdefer-type-errors -fno-w
 test('T9858c', normal, compile_and_run, [''])
 test('T9858d', normal, compile_and_run, [''])
 test('T10284', exit_code(1), compile_and_run, [''])
+test('T11230', normal, compile_and_run, [''])
-- 
cgit v1.2.1