diff options
| author | Richard Eisenberg <eir@cis.upenn.edu> | 2015-12-15 17:36:32 -0500 |
|---|---|---|
| committer | Richard Eisenberg <eir@cis.upenn.edu> | 2015-12-17 12:58:29 -0500 |
| commit | 1722fa106e10e63160bb2322e2ccb830fd5b9ab3 (patch) | |
| tree | 55b03d5e3162c6fd1fae5081cf61fcab0d7c7fa0 /testsuite | |
| parent | ae86eb9f72fa7220fe47ac54d6d21395691c1308 (diff) | |
| download | haskell-1722fa106e10e63160bb2322e2ccb830fd5b9ab3.tar.gz | |
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
Diffstat (limited to 'testsuite')
4 files changed, 37 insertions, 0 deletions
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, ['']) |