Testsuite: add test for #10767

2 files changed, 49 insertions, 0 deletions

diff --git a/testsuite/tests/deSugar/should_compile/T10767.hs b/testsuite/tests/deSugar/should_compile/T10767.hs
new file mode 100644
index 0000000000..65d08f4c8b
--- /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 1ae9011ebe..543e01e8b3 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, [''])