Add failing test case for #13588

4 files changed, 230 insertions, 0 deletions

diff --git a/testsuite/tests/simplStg/should_compile/Makefile b/testsuite/tests/simplStg/should_compile/Makefile
new file mode 100644
index 0000000000..9101fbd40a
--- /dev/null
+++ b/testsuite/tests/simplStg/should_compile/Makefile
@@ -0,0 +1,3 @@
+TOP=../../..
+include $(TOP)/mk/boilerplate.mk
+include $(TOP)/mk/test.mk
diff --git a/testsuite/tests/simplStg/should_compile/T13588.hs b/testsuite/tests/simplStg/should_compile/T13588.hs
new file mode 100644
index 0000000000..60802e40c7
--- /dev/null
+++ b/testsuite/tests/simplStg/should_compile/T13588.hs
@@ -0,0 +1,11 @@
+module T13588 where
+
+newtype T a = MkT a
+f (x, y) = (MkT x, y)
+{-# NOINLINE f #-}
+
+
+bar x =
+    let y = f (x,x) in
+    let z = case y of (MkT x,y) -> (x,y) in
+    (z,z)
diff --git a/testsuite/tests/simplStg/should_compile/T13588.stderr b/testsuite/tests/simplStg/should_compile/T13588.stderr
new file mode 100644
index 0000000000..15075cd3fc
--- /dev/null
+++ b/testsuite/tests/simplStg/should_compile/T13588.stderr
@@ -0,0 +1,194 @@
+
+==================== Pre unarise: ====================
+T13588.f [InlPrag=NOINLINE]
+  :: forall a b. (a, b) -> (T13588.T a, b)
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=<S,1*U(U,U)>m,
+ Unf=OtherCon []] =
+    \r [ds_s16c] ds_s16c
+
+T13588.bar :: forall p. p -> ((p, p), (p, p))
+[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>m, Unf=OtherCon []] =
+    \r [x_s16g]
+        let {
+          z_s16h :: (p_apU, p_apU)
+          [LclId] =
+              \u []
+                  let {
+                    sat_s16i [Occ=Once] :: (p_apU, p_apU)
+                    [LclId] =
+                        NO_CCS (,)! [x_s16g x_s16g];
+                  } in 
+                    T13588.f sat_s16i
+        } in  (,) [z_s16h z_s16h];
+
+T13588.$trModule4 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "main"#;
+
+T13588.$trModule3 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$trModule4];
+
+T13588.$trModule2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "T13588"#;
+
+T13588.$trModule1 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$trModule2];
+
+T13588.$trModule :: GHC.Types.Module
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.Module! [T13588.$trModule3 T13588.$trModule1];
+
+$krep_rWb :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] =
+    NO_CCS GHC.Types.KindRepVar! [0#];
+
+T13588.$tcT2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "T"#;
+
+T13588.$tcT1 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$tcT2];
+
+T13588.$tcT :: GHC.Types.TyCon
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TyCon! [9914527138947624038##
+                             3422500573749473391##
+                             T13588.$trModule
+                             T13588.$tcT1
+                             0#
+                             GHC.Types.krep$*Arr*];
+
+$krep1_rWc :: [GHC.Types.KindRep]
+[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] =
+    NO_CCS :! [$krep_rWb GHC.Types.[]];
+
+$krep2_rWd :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.KindRepTyConApp! [T13588.$tcT $krep1_rWc];
+
+T13588.$tc'MkT1 [InlPrag=[~]] :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] =
+    NO_CCS GHC.Types.KindRepFun! [$krep_rWb $krep2_rWd];
+
+T13588.$tc'MkT3 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "'MkT"#;
+
+T13588.$tc'MkT2 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$tc'MkT3];
+
+T13588.$tc'MkT :: GHC.Types.TyCon
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TyCon! [10510530663172775680##
+                             2880313600721972825##
+                             T13588.$trModule
+                             T13588.$tc'MkT2
+                             1#
+                             T13588.$tc'MkT1];
+
+
+
+==================== STG syntax: ====================
+T13588.f [InlPrag=NOINLINE]
+  :: forall a b. (a, b) -> (T13588.T a, b)
+[GblId,
+ Arity=1,
+ Caf=NoCafRefs,
+ Str=<S,1*U(U,U)>m,
+ Unf=OtherCon []] =
+    \r [ds_s16c] ds_s16c
+
+T13588.bar :: forall p. p -> ((p, p), (p, p))
+[GblId, Arity=1, Caf=NoCafRefs, Str=<L,U>m, Unf=OtherCon []] =
+    \r [x_s16g]
+        let {
+          z_s16h :: (p_apU, p_apU)
+          [LclId] =
+              \u []
+                  let {
+                    sat_s16i [Occ=Once] :: (p_apU, p_apU)
+                    [LclId] =
+                        NO_CCS (,)! [x_s16g x_s16g];
+                  } in 
+                    T13588.f sat_s16i
+        } in  (,) [z_s16h z_s16h];
+
+T13588.$trModule4 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "main"#;
+
+T13588.$trModule3 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$trModule4];
+
+T13588.$trModule2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "T13588"#;
+
+T13588.$trModule1 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$trModule2];
+
+T13588.$trModule :: GHC.Types.Module
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.Module! [T13588.$trModule3 T13588.$trModule1];
+
+$krep_rWb :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] =
+    NO_CCS GHC.Types.KindRepVar! [0#];
+
+T13588.$tcT2 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "T"#;
+
+T13588.$tcT1 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$tcT2];
+
+T13588.$tcT :: GHC.Types.TyCon
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TyCon! [9914527138947624038##
+                             3422500573749473391##
+                             T13588.$trModule
+                             T13588.$tcT1
+                             0#
+                             GHC.Types.krep$*Arr*];
+
+$krep1_rWc :: [GHC.Types.KindRep]
+[GblId, Caf=NoCafRefs, Str=m2, Unf=OtherCon []] =
+    NO_CCS :! [$krep_rWb GHC.Types.[]];
+
+$krep2_rWd :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.KindRepTyConApp! [T13588.$tcT $krep1_rWc];
+
+T13588.$tc'MkT1 [InlPrag=[~]] :: GHC.Types.KindRep
+[GblId, Caf=NoCafRefs, Str=m4, Unf=OtherCon []] =
+    NO_CCS GHC.Types.KindRepFun! [$krep_rWb $krep2_rWd];
+
+T13588.$tc'MkT3 :: GHC.Prim.Addr#
+[GblId, Caf=NoCafRefs, Unf=OtherCon []] =
+    "'MkT"#;
+
+T13588.$tc'MkT2 :: GHC.Types.TrName
+[GblId, Caf=NoCafRefs, Str=m1, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TrNameS! [T13588.$tc'MkT3];
+
+T13588.$tc'MkT :: GHC.Types.TyCon
+[GblId, Caf=NoCafRefs, Str=m, Unf=OtherCon []] =
+    NO_CCS GHC.Types.TyCon! [10510530663172775680##
+                             2880313600721972825##
+                             T13588.$trModule
+                             T13588.$tc'MkT2
+                             1#
+                             T13588.$tc'MkT1];
+
+
diff --git a/testsuite/tests/simplStg/should_compile/all.T b/testsuite/tests/simplStg/should_compile/all.T
new file mode 100644
index 0000000000..559d357739
--- /dev/null
+++ b/testsuite/tests/simplStg/should_compile/all.T
@@ -0,0 +1,22 @@
+# Args to compile_and_run are:
+#	extra compile flags
+#	extra run flags
+#	expected process return value, if not zero
+
+# Only compile with optimisation
+def f( name, opts ):
+  opts.only_ways = ['optasm']
+
+setTestOpts(f)
+
+def checkStgString(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)
+
+
+
+test('T13588', [ checkStgString('case'), expect_broken(13588) ] , compile, ['-ddump-stg'])