diff options
-rw-r--r-- | testsuite/tests/stranal/should_run/T12368.hs | 27 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/T12368.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/stranal/should_run/all.T | 1 |
3 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/stranal/should_run/T12368.hs b/testsuite/tests/stranal/should_run/T12368.hs new file mode 100644 index 0000000000..e8307613e1 --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368.hs @@ -0,0 +1,27 @@ +-- If care is not taken when aborting a fixed-point iteration, wrong absentness +-- information escapes + +-- Needs to be a product type +data Stream = S Int Stream + +bar :: Int -> Stream -> Int +bar n s = foo n s + where + foo :: Int -> Stream -> Int + foo 0 (S n s) = 0 + foo i (S n s) = n + foo (i-1) s +{-# NOINLINE bar #-} + + +baz :: Int -> Stream -> Int +baz 0 not_absent = 0 +baz 1 not_absent = baz 2 not_absent +baz x not_absent = bar 1000 arg + where + arg = S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ S 1 $ not_absent + +bamf x = baz x (S x (error "This is good!")) +{-# NOINLINE bamf #-} + +main :: IO () +main = bamf 10 `seq` return () diff --git a/testsuite/tests/stranal/should_run/T12368.stderr b/testsuite/tests/stranal/should_run/T12368.stderr new file mode 100644 index 0000000000..05025ac78e --- /dev/null +++ b/testsuite/tests/stranal/should_run/T12368.stderr @@ -0,0 +1,3 @@ +T12368: This is good! +CallStack (from HasCallStack): + error, called at T12368.hs:24:22 in main:Main diff --git a/testsuite/tests/stranal/should_run/all.T b/testsuite/tests/stranal/should_run/all.T index a4b550e698..6846c8281c 100644 --- a/testsuite/tests/stranal/should_run/all.T +++ b/testsuite/tests/stranal/should_run/all.T @@ -12,3 +12,4 @@ test('T10148', normal, compile_and_run, ['']) test('T10218', normal, compile_and_run, ['']) test('T11076', normal, multimod_compile_and_run, ['T11076.hs', 'T11076_prim.cmm']) test('T11555a', normal, compile_and_run, ['']) +test('T12368', [ exit_code(1), expect_broken(12368) ], compile_and_run, ['']) |