Add testcase for #11770

and use normalise_errmsg_fun to check the core output in all.T, instead
relying on code in the Makefile.

7 files changed, 119 insertions, 23 deletions

diff --git a/testsuite/tests/stranal/should_compile/Makefile b/testsuite/tests/stranal/should_compile/Makefile
index 1b289c6124..9101fbd40a 100644
--- a/testsuite/tests/stranal/should_compile/Makefile
+++ b/testsuite/tests/stranal/should_compile/Makefile
@@ -1,21 +1,3 @@
 TOP=../../..
 include $(TOP)/mk/boilerplate.mk
 include $(TOP)/mk/test.mk
-
-# T10482
-#   The intent here is to check that $wfoo has type
-#         $wfoo :: Int# -> Int# -> Int
-#   with two unboxed args.  See Trac #10482 for background
-T10482:
-	$(RM) -f T10482.o T10482.hi
-	# Set -dppr-cols to ensure output doesn't wrap
-	'$(TEST_HC)' $(TEST_HC_OPTS) -dppr-cols=200 -O -c -ddump-simpl T10482.hs | grep 'T10482.*wfoo.*Int'
-
-T10482a:
-	$(RM) -f T10482a.o T10482a.hi
-	# Set -dppr-cols to ensure output doesn't wrap
-	'$(TEST_HC)' $(TEST_HC_OPTS) -dppr-cols=200 -O -c -ddump-simpl T10482a.hs | grep 'wf.*Int'
-
-T10694:
-	$(RM) -f T10694.o
-	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c -ddump-simpl T10694.hs | grep 'Str='
diff --git a/testsuite/tests/stranal/should_compile/T10482.stdout b/testsuite/tests/stranal/should_compile/T10482.stderr
index 7f8789d5f4..7f8789d5f4 100644
--- a/testsuite/tests/stranal/should_compile/T10482.stdout
+++ b/testsuite/tests/stranal/should_compile/T10482.stderr
diff --git a/testsuite/tests/stranal/should_compile/T10482a.stdout b/testsuite/tests/stranal/should_compile/T10482a.stderr
index d26b45fe1a..d26b45fe1a 100644
--- a/testsuite/tests/stranal/should_compile/T10482a.stdout
+++ b/testsuite/tests/stranal/should_compile/T10482a.stderr
diff --git a/testsuite/tests/stranal/should_compile/T10694.stdout b/testsuite/tests/stranal/should_compile/T10694.stderr
index 1908a08afe..1908a08afe 100644
--- a/testsuite/tests/stranal/should_compile/T10694.stdout
+++ b/testsuite/tests/stranal/should_compile/T10694.stderr
diff --git a/testsuite/tests/stranal/should_compile/T11770.hs b/testsuite/tests/stranal/should_compile/T11770.hs
new file mode 100644
index 0000000000..6b669f903b
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T11770.hs
@@ -0,0 +1,11 @@
+module T11770 where
+
+
+foo :: Int -> Int ->  Int
+foo 10 c = 0
+foo n c =
+        -- Bar should not be marked as one-shot
+    let bar :: Int -> Int
+        bar n = n + c
+        {-# NOINLINE bar #-}
+    in bar n + foo (bar (n+1)) c
diff --git a/testsuite/tests/stranal/should_compile/T11770.stderr b/testsuite/tests/stranal/should_compile/T11770.stderr
new file mode 100644
index 0000000000..82f6a9d1f9
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T11770.stderr
@@ -0,0 +1,85 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 56, types: 25, coercions: 0}
+
+-- RHS size: {terms: 2, types: 0, coercions: 0}
+T11770.$trModule2 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 20}]
+T11770.$trModule2 = GHC.Types.TrNameS "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0}
+T11770.$trModule1 :: GHC.Types.TrName
+[GblId,
+ Caf=NoCafRefs,
+ Str=m1,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 40 20}]
+T11770.$trModule1 = GHC.Types.TrNameS "T11770"#
+
+-- RHS size: {terms: 3, types: 0, coercions: 0}
+T11770.$trModule :: GHC.Types.Module
+[GblId,
+ Caf=NoCafRefs,
+ Str=m,
+ Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+T11770.$trModule =
+  GHC.Types.Module T11770.$trModule2 T11770.$trModule1
+
+Rec {
+-- RHS size: {terms: 32, types: 11, coercions: 0}
+T11770.$wfoo [InlPrag=[0], Occ=LoopBreaker]
+  :: GHC.Prim.Int# -> Int -> GHC.Prim.Int#
+[GblId, Arity=2, Caf=NoCafRefs, Str=<S,U><L,U(U)>]
+T11770.$wfoo =
+  \ (ww_s1Mj :: GHC.Prim.Int#) (w_s1Mg :: Int) ->
+    case ww_s1Mj of ds_X1Lc {
+      __DEFAULT ->
+        let {
+          bar_s1LA [InlPrag=NOINLINE] :: Int -> Int
+          [LclId, Arity=1, Str=<S(S),1*U(U)>m {axl-><S(S),1*U(U)>}]
+          bar_s1LA =
+            \ (n_axp :: Int) ->
+              GHC.Num.$fNumInt_$c+ n_axp w_s1Mg } in
+        case bar_s1LA (GHC.Types.I# ds_X1Lc)
+        of _ [Occ=Dead] { GHC.Types.I# x_a1Lp ->
+        case bar_s1LA (GHC.Types.I# (GHC.Prim.+# ds_X1Lc 1#))
+        of _ [Occ=Dead] { GHC.Types.I# ww2_X1MK ->
+        case T11770.$wfoo ww2_X1MK w_s1Mg of ww3_s1Mn { __DEFAULT ->
+        GHC.Prim.+# x_a1Lp ww3_s1Mn
+        }
+        }
+        };
+      10# -> 0#
+    }
+end Rec }
+
+-- RHS size: {terms: 12, types: 5, coercions: 0}
+foo [InlPrag=INLINE[0]] :: Int -> Int -> Int
+[GblId,
+ Arity=2,
+ Caf=NoCafRefs,
+ Str=<S(S),1*U(U)><L,U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
+         WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
+         Tmpl= \ (w_s1Mf [Occ=Once!] :: Int) (w1_s1Mg [Occ=Once] :: Int) ->
+                 case w_s1Mf of _ [Occ=Dead] { GHC.Types.I# ww1_s1Mj [Occ=Once] ->
+                 case T11770.$wfoo ww1_s1Mj w1_s1Mg of ww2_s1Mn { __DEFAULT ->
+                 GHC.Types.I# ww2_s1Mn
+                 }
+                 }}]
+foo =
+  \ (w_s1Mf :: Int) (w1_s1Mg :: Int) ->
+    case w_s1Mf of _ [Occ=Dead] { GHC.Types.I# ww1_s1Mj ->
+    case T11770.$wfoo ww1_s1Mj w1_s1Mg of ww2_s1Mn { __DEFAULT ->
+    GHC.Types.I# ww2_s1Mn
+    }
+    }
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index d2fc18d1e5..3ac075b716 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -1,6 +1,19 @@
 # Only compile with optimisation
 setTestOpts( only_ways(['optasm']) )
 
+def checkCoreString(needle):
+    def norm(str):
+        if needle in str:
+            return "%s contained in -ddump-simpl\n" % needle
+        else:
+            return "%s not contained in -ddump-simpl\n" % needle
+    return normalise_errmsg_fun(norm)
+
+def grepCoreString(needle):
+    def norm(str):
+        return "".join(filter(lambda l: re.search(needle, l), str.splitlines(True)))
+    return normalise_errmsg_fun(norm)
+
 test('default', normal, compile, [''])
 test('fact', normal, compile, [''])
 test('fun', normal, compile, [''])
@@ -20,13 +33,18 @@ test('T8467', normal, compile, [''])
 test('T8037', normal, compile, [''])
 test('T8743', [ extra_clean(['T8743.o-boot', 'T8743a.hi', 'T8743a.o', 'T8743.hi-boot']) ], multimod_compile, ['T8743', '-v0'])
 
-# test('T10482', normal, compile, [''])
-
-test('T10482',  only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10482'])
-test('T10482a', only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10482a'])
+# T10482
+#   The intent here is to check that $wfoo has type
+#         $wfoo :: Int# -> Int# -> Int
+#   with two unboxed args.  See Trac #10482 for background
+test('T10482',  [ grepCoreString(r'wfoo.*Int') ], compile, ['-dppr-cols=200 -ddump-simpl'])
+test('T10482a', [ grepCoreString(r'wf.*Int') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
 
 test('T9208', when(compiler_debugged(), expect_broken(9208)), compile, [''])
 # T9208 fails (and should do so) if you have assertion checking on in the compiler
 # Hence the above expect_broken.  See comments in the Trac ticket
 
-test('T10694', only_ways(['normal']), run_command, ['$MAKE -s --no-print-directory T10694'])
+test('T10694', [ grepCoreString(r'Str=') ],   compile, ['-dppr-cols=200 -ddump-simpl'])
+test('T11770', [ expect_broken(117700), checkCoreString("OneShot") ], compile, ['-ddump-simpl'])
+
+