diff options
author | Joachim Breitner <mail@joachim-breitner.de> | 2016-07-07 10:41:38 +0200 |
---|---|---|
committer | Joachim Breitner <mail@joachim-breitner.de> | 2016-07-07 10:41:38 +0200 |
commit | b9cea81ded5dc4da19fc011d96f28ade660438c2 (patch) | |
tree | c49c2073ba231684c9415855b53c874005fafe52 | |
parent | 672314cbeb8ac386a58f17dc4650dbdf4c55d8b5 (diff) | |
download | haskell-b9cea81ded5dc4da19fc011d96f28ade660438c2.tar.gz |
Show testcase where demand analysis abortion code fails
By making it believe that some deeply nested value is absent when it
really isn't. See #12368.
-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, ['']) |