[commit: ghc] master: Testsuite: add test for #10767 (1395185)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/1395185f56cda4774d27ae419b10f570276b674d/ghc

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

commit 1395185f56cda4774d27ae419b10f570276b674d
Author: Thomas Miedema <thomasmiedema at gmail.com>
Date:   Thu Sep 24 14:51:56 2015 +0200

    Testsuite: add test for #10767


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

1395185f56cda4774d27ae419b10f570276b674d
 testsuite/tests/deSugar/should_compile/T10767.hs | 48 ++++++++++++++++++++++++
 testsuite/tests/deSugar/should_compile/all.T     |  1 +
 2 files changed, 49 insertions(+)

diff --git a/testsuite/tests/deSugar/should_compile/T10767.hs b/testsuite/tests/deSugar/should_compile/T10767.hs
new file mode 100644
index 0000000..65d08f4
--- /dev/null
+++ b/testsuite/tests/deSugar/should_compile/T10767.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE ScopedTypeVariables, TypeFamilies #-}
+
+module Main where
+
+{- ghc-7.8.4 and ghc-7.10.2 showed a confusing warning:
+
+T10767.hs:43:1: Warning:
+    RULE left-hand side too complicated to desugar
+      Optimised lhs: case cobox_aWY
+                     of _ [Occ=Dead] { GHC.Types.Eq# cobox ->
+                     genLength @ Int $dSpecList_aWX
+                     }
+      Orig lhs: case cobox_aWY of cobox_aWY { GHC.Types.Eq# cobox ->
+                genLength @ Int $dSpecList_aWX
+                }
+-}
+
+import Data.Proxy
+
+class SpecList a where
+    type List a :: *
+
+    slCase      :: List a -> b -> (a -> List a -> b) -> b
+
+data IntList
+  = ILNil
+  | ILCons {-# UNPACK #-} !Int IntList
+  deriving (Show)
+
+instance SpecList Int where
+  type List Int = IntList
+
+  slCase ILNil        n _  = n
+  slCase (ILCons i t) _ c  = c i t
+
+fromList :: [Int] -> IntList
+fromList []      = ILNil
+fromList (h : t) = ILCons h (fromList t)
+
+lst1 :: IntList
+lst1 = fromList [1..10]
+
+{-# SPECIALIZE genLength :: Proxy Int -> List Int -> Int #-}
+genLength :: forall a . SpecList a => Proxy a -> List a -> Int
+genLength p lst = slCase lst 0 (\(_ :: a) tail -> 1 + genLength p tail)
+
+main :: IO ()
+main = print (genLength (Proxy :: Proxy Int) lst1)
diff --git a/testsuite/tests/deSugar/should_compile/all.T b/testsuite/tests/deSugar/should_compile/all.T
index 1ae9011..543e01e 100644
--- a/testsuite/tests/deSugar/should_compile/all.T
+++ b/testsuite/tests/deSugar/should_compile/all.T
@@ -102,3 +102,4 @@ test('T2431', normal, compile, ['-ddump-simpl -dsuppress-uniques'])
 test('T7669', normal, compile, [''])
 test('T8470', normal, compile, [''])
 test('T10251', normal, compile, [''])
+test('T10767', normal, compile, [''])