From 646b6dfbe125aa756a935e840979ba11b4a882c0 Mon Sep 17 00:00:00 2001 From: Krzysztof Gogolewski Date: Tue, 26 Feb 2019 17:22:28 +0100 Subject: Fix map/coerce rule for newtypes with wrappers This addresses Trac #16208 by marking newtype wrapper unfoldings as compulsory. Furthermore, we can remove the special case for newtypes in exprIsConApp_maybe (introduced in 7833cf407d1f). --- testsuite/tests/simplCore/should_run/T16208.hs | 17 +++++++++++++++++ testsuite/tests/simplCore/should_run/T16208.stdout | 1 + testsuite/tests/simplCore/should_run/all.T | 1 + 3 files changed, 19 insertions(+) create mode 100644 testsuite/tests/simplCore/should_run/T16208.hs create mode 100644 testsuite/tests/simplCore/should_run/T16208.stdout (limited to 'testsuite') diff --git a/testsuite/tests/simplCore/should_run/T16208.hs b/testsuite/tests/simplCore/should_run/T16208.hs new file mode 100644 index 0000000000..e346ab84f6 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T16208.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE GADTs, ExplicitForAll #-} +module Main (main) where + +import GHC.Exts + +newtype Age a b where + Age :: forall b a. Int -> Age a b + +data T a = MkT a + +{-# NOINLINE foo #-} +foo :: (Int -> Age Bool Char) -> String +foo _ = "bad (RULE should have fired)" + +{-# RULES "foo/coerce" [1] foo coerce = "good" #-} + +main = putStrLn (foo Age) diff --git a/testsuite/tests/simplCore/should_run/T16208.stdout b/testsuite/tests/simplCore/should_run/T16208.stdout new file mode 100644 index 0000000000..12799ccbe7 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T16208.stdout @@ -0,0 +1 @@ +good diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index f8089438c5..646929f778 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -50,6 +50,7 @@ test('T5441', [], multimod_compile_and_run, ['T5441', '']) test('T5603', reqlib('integer-gmp'), compile_and_run, ['']) test('T2110', normal, compile_and_run, ['']) test('AmapCoerce', normal, compile_and_run, ['']) +test('T16208', normal, compile_and_run, ['']) # Run these tests *without* optimisation too test('T5625', [ only_ways(['normal','optasm']), exit_code(1) ], compile_and_run, ['']) -- cgit v1.2.1