diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2023-03-29 11:08:06 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-03-31 21:28:28 -0400 |
commit | 0077cb225bde18ee6c7ff49d6486eb20fc6c011a (patch) | |
tree | efbac698822d21be8606fdb8c47b49e80ed2601f /testsuite | |
parent | ea853ff066afb4d4f2271b24be898693e2a3e18d (diff) | |
download | haskell-0077cb225bde18ee6c7ff49d6486eb20fc6c011a.tar.gz |
Add test for T23184
There was an outright bug, which Simon fixed in July 2021, as a little side-fix on a complicated patch:
```
commit 6656f0165a30fc2a22208532ba384fc8e2f11b46
Author: Simon Peyton Jones <simonpj@microsoft.com>
Date: Fri Jul 23 23:57:01 2021 +0100
A bunch of changes related to eta reduction
This is a large collection of changes all relating to eta
reduction, originally triggered by #18993, but there followed
a long saga.
Specifics:
...lots of lines omitted...
Other incidental changes
* Fix a fairly long-standing outright bug in the ApplyToVal case of
GHC.Core.Opt.Simplify.mkDupableContWithDmds. I was failing to take the
tail of 'dmds' in the recursive call, which meant the demands were All
Wrong. I have no idea why this has not caused problems before now.
```
Note this "Fix a fairly longstanding outright bug". This is the specific fix
```
@@ -3552,8 +3556,8 @@ mkDupableContWithDmds env dmds
-- let a = ...arg...
-- in [...hole...] a
-- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
- do { let (dmd:_) = dmds -- Never fails
- ; (floats1, cont') <- mkDupableContWithDmds env dmds cont
+ do { let (dmd:cont_dmds) = dmds -- Never fails
+ ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
; let env' = env `setInScopeFromF` floats1
; (_, se', arg') <- simplArg env' dup se arg
; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
```
Ticket #23184 is a report of the bug that this diff fixes.
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/simplCore/should_run/T23184.hs | 18 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/T23184.stdout | 1 | ||||
-rw-r--r-- | testsuite/tests/simplCore/should_run/all.T | 1 |
3 files changed, 20 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_run/T23184.hs b/testsuite/tests/simplCore/should_run/T23184.hs new file mode 100644 index 0000000000..ea98bb313f --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T23184.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE BangPatterns #-} +module Main where + +import GHC.Magic + +main :: IO () +main = print $ noinline (\x -> sum $ tardisManual [0..x]) 0 + +tardisManual :: [Int] -> [Int] +tardisManual xs = + let + go [] !acc _ = ([], 0) + go (_:xs) !acc l = + let (xs', _) = go xs acc l + in (l:xs', 0) + (r, l) = go xs True l + in r +{-# INLINE tardisManual #-} diff --git a/testsuite/tests/simplCore/should_run/T23184.stdout b/testsuite/tests/simplCore/should_run/T23184.stdout new file mode 100644 index 0000000000..573541ac97 --- /dev/null +++ b/testsuite/tests/simplCore/should_run/T23184.stdout @@ -0,0 +1 @@ +0 diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T index 928bf89df9..fc3d605ac7 100644 --- a/testsuite/tests/simplCore/should_run/all.T +++ b/testsuite/tests/simplCore/should_run/all.T @@ -109,4 +109,5 @@ test('T21575b', [], multimod_compile_and_run, ['T21575b', '-O']) test('T20836', normal, compile_and_run, ['-O0']) # Should not time out; See #20836 test('T22448', normal, compile_and_run, ['-O1']) test('T22998', normal, compile_and_run, ['-O0 -fspecialise -dcore-lint']) +test('T23184', normal, compile_and_run, ['-O']) |