Test for #7116 (strength reduction)

4 files changed, 97 insertions, 0 deletions

diff --git a/testsuite/tests/numeric/should_compile/Makefile b/testsuite/tests/numeric/should_compile/Makefile
new file mode 100644
index 0000000000..12c3cf9a1c
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/Makefile
@@ -0,0 +1,7 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
+
+T7116:
+	$(RM) -f T7116.o T7116.hi
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O2 -c -ddump-simpl T7116.hs
diff --git a/testsuite/tests/numeric/should_compile/T7116.hs b/testsuite/tests/numeric/should_compile/T7116.hs
new file mode 100644
index 0000000000..cdaa432dbd
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T7116.hs
@@ -0,0 +1,19 @@
+module T7116 where
+
+-- this module tests strength reduction, i.e. turning floating
+-- point multiplication by two into addition:
+--
+-- 2.0 * x -> x + x
+
+dl :: Double -> Double
+dl x = 2.0 * x
+
+dr :: Double -> Double
+dr x = x * 2.0
+
+fl :: Float -> Float
+fl x = 2.0 * x
+
+fr :: Float -> Float
+fr x = x * 2.0
+
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
new file mode 100644
index 0000000000..d696b913a1
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -0,0 +1,70 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 22, types: 14, coercions: 0}
+
+T7116.dl :: GHC.Types.Double -> GHC.Types.Double
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
+         ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x_ae1 [Occ=Once!] :: GHC.Types.Double) ->
+                 case x_ae1 of _ { GHC.Types.D# y_afn ->
+                 GHC.Types.D# (GHC.Prim.+## y_afn y_afn)
+                 }}]
+T7116.dl =
+  \ (x_ae1 :: GHC.Types.Double) ->
+    case x_ae1 of _ { GHC.Types.D# y_afn ->
+    GHC.Types.D# (GHC.Prim.+## y_afn y_afn)
+    }
+
+T7116.dr :: GHC.Types.Double -> GHC.Types.Double
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
+         ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x_aem [Occ=Once!] :: GHC.Types.Double) ->
+                 case x_aem of _ { GHC.Types.D# x1_afj ->
+                 GHC.Types.D# (GHC.Prim.+## x1_afj x1_afj)
+                 }}]
+T7116.dr = T7116.dl
+
+T7116.fl :: GHC.Types.Float -> GHC.Types.Float
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
+         ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x_aen [Occ=Once!] :: GHC.Types.Float) ->
+                 case x_aen of _ { GHC.Types.F# y_afx ->
+                 GHC.Types.F# (GHC.Prim.plusFloat# y_afx y_afx)
+                 }}]
+T7116.fl =
+  \ (x_aen :: GHC.Types.Float) ->
+    case x_aen of _ { GHC.Types.F# y_afx ->
+    GHC.Types.F# (GHC.Prim.plusFloat# y_afx y_afx)
+    }
+
+T7116.fr :: GHC.Types.Float -> GHC.Types.Float
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=DmdType <S,1*U(U)>m,
+ Unf=Unf{Src=InlineStable, TopLvl=True, Arity=1, Value=True,
+         ConLike=True, WorkFree=True, Expandable=True,
+         Guidance=ALWAYS_IF(unsat_ok=True,boring_ok=False)
+         Tmpl= \ (x_aeo [Occ=Once!] :: GHC.Types.Float) ->
+                 case x_aeo of _ { GHC.Types.F# x1_aft ->
+                 GHC.Types.F# (GHC.Prim.plusFloat# x1_aft x1_aft)
+                 }}]
+T7116.fr = T7116.fl
+
+
+
diff --git a/testsuite/tests/numeric/should_compile/all.T b/testsuite/tests/numeric/should_compile/all.T
new file mode 100644
index 0000000000..3e8d4d3c61
--- /dev/null
+++ b/testsuite/tests/numeric/should_compile/all.T
@@ -0,0 +1 @@
+test('T7116', normal, run_command, ['$MAKE -s --no-print-directory T7116'])