[commit: ghc] master: Add a test for #12600 (56de222)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/56de2225fa5d22f38b93489a03d5c8b7301b759e/ghc

>---------------------------------------------------------------

commit 56de2225fa5d22f38b93489a03d5c8b7301b759e
Author: David Feuer <david.feuer at gmail.com>
Date:   Sat May 13 19:26:59 2017 -0400

    Add a test for #12600
    
    Reviewers: austin, bgamari
    
    Reviewed By: bgamari
    
    Subscribers: rwbarton, thomie
    
    GHC Trac Issues: #12600
    
    Differential Revision: https://phabricator.haskell.org/D3580


>---------------------------------------------------------------

56de2225fa5d22f38b93489a03d5c8b7301b759e
 testsuite/tests/simplCore/should_compile/Makefile  |  5 ++++
 testsuite/tests/simplCore/should_compile/T12600.hs | 29 ++++++++++++++++++++++
 .../tests/simplCore/should_compile/T12600.stdout   |  1 +
 testsuite/tests/simplCore/should_compile/all.T     |  4 +++
 4 files changed, 39 insertions(+)

diff --git a/testsuite/tests/simplCore/should_compile/Makefile b/testsuite/tests/simplCore/should_compile/Makefile
index a01edb2..f56a851 100644
--- a/testsuite/tests/simplCore/should_compile/Makefile
+++ b/testsuite/tests/simplCore/should_compile/Makefile
@@ -225,3 +225,8 @@ T13340:
 T11272:
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O T11272a.hs
 	'$(TEST_HC)' $(TEST_HC_OPTS) -c -O -ddump-prep T11272.hs | { ! grep Ord ;}
+
+# We expect to see a $wfoo worker that doesn't take any dictionaries.
+.PHONY: T12600
+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
diff --git a/testsuite/tests/simplCore/should_compile/T12600.hs b/testsuite/tests/simplCore/should_compile/T12600.hs
new file mode 100644
index 0000000..d08d923
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T12600.hs
@@ -0,0 +1,29 @@
+module T12600 where
+
+-- We don't want to see any dictionary-passing in foo. Everything
+-- should be inlined or specialized away.
+
+class Eq1 f where
+  eq1 :: Eq a => f a -> f a -> Bool
+
+data F a = F !a !a
+data G f a = G !(f a) !(f a)
+
+instance Eq1 F where
+  eq1 = \(F a b) (F c d) ->
+    -- In order to reproduce the problem, the body of this function needs to be
+    -- large enough to prevent GHC from voluntarily inlining it.
+    larger $ larger $ larger $ larger $ larger $ larger $
+      a == c && b == d
+  {-# INLINE eq1 #-}
+
+larger :: a -> a
+larger = id
+{-# NOINLINE larger #-}
+
+instance (Eq1 f) => Eq1 (G f) where
+  eq1 = \(G a b) (G c d) -> eq1 a c && eq1 b d
+  {-# INLINE eq1 #-}
+
+foo :: G F Int -> G F Int -> Bool
+foo a b = eq1 a b
diff --git a/testsuite/tests/simplCore/should_compile/T12600.stdout b/testsuite/tests/simplCore/should_compile/T12600.stdout
new file mode 100644
index 0000000..9411874
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T12600.stdout
@@ -0,0 +1 @@
+$wfoo :: Int# -> Int# -> Int# -> Int# -> Int# -> Int# -> Int# -> Int# -> Bool
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 1af5cbe..b8a0c66 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -264,3 +264,7 @@ test('T11272',
      normal,
      run_command,
      ['$MAKE -s --no-print-directory T11272'])
+test('T12600',
+     normal,
+     run_command,
+     ['$MAKE -s --no-print-directory T12600'])