From 7cf09ab013778227caa07b5d7ec9acd5dedd1817 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Thu, 10 Sep 2020 16:46:57 +0100
Subject: Do absence analysis on stable unfoldings

Ticket #18638 showed that Very Bad Things happen if we fail
to do absence analysis on stable unfoldings.  It's all described
in Note [Absence analysis for stable unfoldings and RULES].

I'm a bit surprised this hasn't bitten us before. Fortunately
the fix is pretty simple.
---
 testsuite/tests/simplCore/should_run/T18638.hs     | 54 ++++++++++++++++++++++
 testsuite/tests/simplCore/should_run/T18638.stdout |  1 +
 testsuite/tests/simplCore/should_run/all.T         |  1 +
 3 files changed, 56 insertions(+)
 create mode 100644 testsuite/tests/simplCore/should_run/T18638.hs
 create mode 100644 testsuite/tests/simplCore/should_run/T18638.stdout

(limited to 'testsuite/tests/simplCore/should_run')

diff --git a/testsuite/tests/simplCore/should_run/T18638.hs b/testsuite/tests/simplCore/should_run/T18638.hs
new file mode 100644
index 0000000000..daf35a6e55
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T18638.hs
@@ -0,0 +1,54 @@
+{-# LANGUAGE ExistentialQuantification, BangPatterns #-}
+{-# OPTIONS_GHC -O #-}
+
+module Main (main) where
+
+import Data.IORef (newIORef, readIORef)
+
+data Step s = Done
+            | Skip !s
+            | Yield !Char !s
+
+data Stream = forall s. Stream (s -> Step s) !s !Int
+
+unstreamList :: Stream -> [Char]
+unstreamList (Stream next s0 _) = unfold s0
+    where unfold !s = case next s of
+                        Done       -> []
+                        Skip s'    -> unfold s'
+                        Yield x s' -> x : unfold s'
+{-# INLINE [0] unstreamList #-}
+
+appendS :: Stream -> Stream -> Stream
+appendS (Stream next s len) _ = Stream next s len
+{-# INLINE [0] appendS #-}
+
+justifyLeftI :: Int -> Int -> Stream
+justifyLeftI k u =
+  let
+       next Nothing = next (Just 0)
+       next (Just n)
+           | n < k       = Yield 'a' (Just (n+1))
+           | otherwise   = Done
+       {-# INLINE next #-}
+
+     in Stream next Nothing (max k u)
+{-# INLINE [0] justifyLeftI #-}
+
+prettyPrintLogStats :: Int -> [String]
+prettyPrintLogStats rawResults = map fromRow columns
+  where
+    columns :: [Int]
+    columns = map (\_ -> 0) [rawResults]
+
+    moduleLen, lineLen :: Int
+    (moduleLen, lineLen) = foldr (\_ (_,_) -> (5, 2)) (0, 0) columns
+
+    fromRow :: Int -> String
+    fromRow x = unstreamList (justifyLeftI moduleLen x `appendS` justifyLeftI lineLen x)
+
+main :: IO ()
+main = do
+    timingsRef <- newIORef 0
+    timings <- readIORef timingsRef
+    putStrLn $ concat $ prettyPrintLogStats timings
diff --git a/testsuite/tests/simplCore/should_run/T18638.stdout b/testsuite/tests/simplCore/should_run/T18638.stdout
new file mode 100644
index 0000000000..ccc3e7b48d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_run/T18638.stdout
@@ -0,0 +1 @@
+aaaaa
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index efaf5efdde..a04558be89 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/testsuite/tests/simplCore/should_run/all.T
@@ -92,3 +92,4 @@ test('T17206', exit_code(1), compile_and_run, [''])
 test('T17151', [], multimod_compile_and_run, ['T17151', ''])
 test('T18012', normal, compile_and_run, [''])
 test('T17744', normal, compile_and_run, [''])
+test('T18638', normal, compile_and_run, [''])
-- 
cgit v1.2.1