Add regression test for #14062wip/sjakobi/T14062-test

Closes #14062.

4 files changed, 56 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index 08d1798fa8..f491939164 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -273,6 +273,12 @@ T11272:
 T12600:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep -dsuppress-all -dsuppress-uniques -dno-suppress-type-signatures -dppr-cols=200 T12600.hs | grep "wfoo" | head -n 1
 
+# test1 and test2 should have the exact same Core.
+.PHONY: T14062
+T14062:
+	$(RM) -f T14062.hi T14062.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-simpl -dsuppress-module-prefixes -dsuppress-uniques -dsuppress-unfoldings T14062.hs | grep -B1 -A5 "^test[12]"
+
 # We don't expect to case match on any literal numbers other than
 # 0 or 1. See T14140.hs for an explanation.
 T14140:
diff --git a/testsuite/tests/simplCore/should_compile/T14062.hs b/testsuite/tests/simplCore/should_compile/T14062.hs
new file mode 100644
index 0000000000..0b8dc5999d
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T14062.hs
@@ -0,0 +1,21 @@
+-- test1 and test2 should have the same Core.
+-- Until GHC 8.2, test1 was faster than test2.
+{-# LANGUAGE FlexibleContexts #-}
+
+module T14062 (test1, test2) where
+
+import Control.Monad.State.Strict
+import Control.Monad.Identity
+
+repeatM :: Monad m => m a -> Int -> m ()
+repeatM f = go where
+    go 0 = pure ()
+    go i = f >> go (i - 1)
+{-# INLINE repeatM #-}
+
+incState :: MonadState Int m => m ()
+incState = modify' (1+) ; {-# INLINE incState #-}
+
+test1, test2 :: Int -> Int
+test1 = \n -> (runIdentity . flip evalStateT 0 . (\a -> repeatM incState a >> get)) n ; {-# INLINE test1 #-}
+test2 = \n -> runIdentity . flip evalStateT 0 $ repeatM incState n >> get ; {-# INLINE test2 #-}
diff --git a/testsuite/tests/simplCore/should_compile/T14062.stdout b/testsuite/tests/simplCore/should_compile/T14062.stdout
new file mode 100644
index 0000000000..6fc4e95e0b
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T14062.stdout
@@ -0,0 +1,28 @@
+-- RHS size: {terms: 10, types: 10, coercions: 0, joins: 0/0}
+test1 [InlPrag=INLINE (sat-args=0)] :: Int -> Int
+[GblId,
+ Arity=1,
+ Str=<1P(1L)>,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)}]
+test1
+  = \ (n :: Int) ->
+      case n of { I# ww1 ->
+      case $wgo ww1 lvl of { (# ww3, ww4 #) -> ww4 }
+      }
+
+-- RHS size: {terms: 10, types: 10, coercions: 0, joins: 0/0}
+test2 [InlPrag=INLINE (sat-args=0)] :: Int -> Int
+[GblId,
+ Arity=1,
+ Str=<1P(1L)>,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=0,unsat_ok=False,boring_ok=True)}]
+test2
+  = \ (n :: Int) ->
+      case n of { I# ww1 ->
+      case $wgo ww1 lvl of { (# ww3, ww4 #) -> ww4 }
+      }
+
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 3a16d55508..63c5663dd0 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -248,6 +248,7 @@ test('T13543', only_ways(['optasm']), compile, ['-ddump-str-signatures -ddump-cp
 test('T11272', normal, makefile_test, ['T11272'])
 test('T12600', normal, makefile_test, ['T12600'])
 test('T13658', normal, compile, ['-dcore-lint'])
+test('T14062', only_ways(['optasm']), makefile_test, ['T14062'])
 test('T14779a', normal, compile, ['-dcore-lint'])
 test('T14779b', normal, compile, ['-dcore-lint'])
 test('T13708', normal, compile, [''])