[Git][ghc/ghc][master] Add test for T23184

[Marge Bot (@marge-bot)]

Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
0077cb22 by Matthew Pickering at 2023-03-31T21:28:28-04:00
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 at 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.

- - - - -


3 changed files:

- + testsuite/tests/simplCore/should_run/T23184.hs
- + testsuite/tests/simplCore/should_run/T23184.stdout
- testsuite/tests/simplCore/should_run/all.T


Changes:

=====================================
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 #-}


=====================================
testsuite/tests/simplCore/should_run/T23184.stdout
=====================================
@@ -0,0 +1 @@
+0


=====================================
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'])
 



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0077cb225bde18ee6c7ff49d6486eb20fc6c011a

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/0077cb225bde18ee6c7ff49d6486eb20fc6c011a
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230331/7d71021d/attachment-0001.html>