Add a test for #4138 (currently failing)

5 files changed, 45 insertions, 0 deletions

diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index 4dddb2eb21..ec72c9627c 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -75,3 +75,11 @@ T5623:
 	$(RM) -f T5623.hi T5623.o
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c T5623.hs -O -ddump-prep | grep -c "plusAddr#"
 
+.PHONY: T4138
+T4138:
+	$(RM) -f T4138.hi   T4138.o
+	$(RM) -f T4138_A.hi T4138_A.o
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T4138_A.hs
+	'$(TEST_HC)' $(TEST_HC_OPTS) -O -c T4138.hs -ddump-simpl > T4138.simpl
+	grep -c 'F#' T4138.simpl
+
diff --git a/testsuite/tests/simplCore/should_compile/T4138.hs b/testsuite/tests/simplCore/should_compile/T4138.hs
new file mode 100644
index 0000000000..211c607685
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T4138.hs
@@ -0,0 +1,20 @@
+
+module T4138 where
+
+import T4138_A
+
+-- We NOINLINE f because we want to count the number of F#s in the
+-- -ddump-simpl output, so we don't want to be confused by F#s
+-- appearing in the inlining
+{-# NOINLINE f #-}
+f :: (Float, Float) -> ()
+f = rnf
+
+{-
+We're hoping that the output will include something like:
+
+  \ (ds_dvm :: (GHC.Types.Float, GHC.Types.Float)) ->
+    case ds_dvm of _ { (x_aux, y_auy) ->
+    case x_aux of _ { GHC.Types.F# ipv_svw ->
+    case y_auy of _ { GHC.Types.F# ipv_svx -> GHC.Unit.() } } }
+-}
diff --git a/testsuite/tests/simplCore/should_compile/T4138.stdout b/testsuite/tests/simplCore/should_compile/T4138.stdout
new file mode 100644
index 0000000000..0cfbf08886
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T4138.stdout
@@ -0,0 +1 @@
+2
diff --git a/testsuite/tests/simplCore/should_compile/T4138_A.hs b/testsuite/tests/simplCore/should_compile/T4138_A.hs
new file mode 100644
index 0000000000..c2dce0c85e
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T4138_A.hs
@@ -0,0 +1,11 @@
+
+module T4138_A where
+
+class NFData a where
+    rnf :: a -> ()
+    rnf a = a `seq` ()
+
+instance NFData Float
+
+instance (NFData a, NFData b) => NFData (a,b) where
+    rnf (x,y) = rnf x `seq` rnf y
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index ac9b8f8639..3104ef2285 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -143,3 +143,8 @@ test('T5776',
      normal,
      run_command,
      ['$MAKE -s --no-print-directory T5776'])
+test('T4138',
+     [extra_clean(['T4138_A.hi', 'T4138_A.o', 'T4138.simpl']),
+      expect_broken(4138)],
+     run_command,
+     ['$MAKE -s --no-print-directory T4138'])