From 42d68364f66846969edf029f878875c10cdfe0b2 Mon Sep 17 00:00:00 2001 From: Sebastian Graf Date: Wed, 25 Mar 2020 13:49:14 +0100 Subject: Preserve precise exceptions in strictness analysis Fix #13380 and #17676 by 1. Changing `raiseIO#` to have `topDiv` instead of `botDiv` 2. Give it special treatment in `Simplifier.Util.mkArgInfo`, treating it as if it still had `botDiv`, to recover dead code elimination. This is the first commit of the plan outlined in https://gitlab.haskell.org/ghc/ghc/-/merge_requests/2525#note_260886. --- testsuite/tests/stranal/should_run/T17676.hs | 18 ++++++++++++++++++ testsuite/tests/stranal/should_run/all.T | 3 ++- 2 files changed, 20 insertions(+), 1 deletion(-) create mode 100644 testsuite/tests/stranal/should_run/T17676.hs (limited to 'testsuite') diff --git a/testsuite/tests/stranal/should_run/T17676.hs b/testsuite/tests/stranal/should_run/T17676.hs new file mode 100644 index 0000000000..d0fa4cf661 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T17676.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE ScopedTypeVariables #-} +import Data.IORef +import Control.Exception +import Control.Monad + +data Exc = Exc deriving Show + +instance Exception Exc + +-- Recursive instead of NOINLINE because of #17673 +f :: Int -> Int -> IO () +f 0 x = do + let true = sum [0..4] == 10 + when true $ throwIO Exc + x `seq` return () +f n x = f (n-1) (x+1) + +main = f 1 (error "expensive computation") `catch` \(_ :: Exc) -> return () diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index 278b91b292..d822e482dd 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -19,7 +19,8 @@ test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm' test('T11555a', normal, compile_and_run, ['']) test('T12368', exit_code(1), compile_and_run, ['']) test('T12368a', exit_code(1), compile_and_run, ['']) -test('T13380', [expect_broken(13380), exit_code(1)], compile_and_run, ['']) +test('T13380', exit_code(1), compile_and_run, ['']) test('T14171', [expect_broken(14171), exit_code(1)], compile_and_run, ['']) test('T14290', normal, compile_and_run, ['']) test('T14285', normal, multimod_compile_and_run, ['T14285', '']) +test('T17676', normal, compile_and_run, ['']) -- cgit v1.2.1