testsuite: Add testcase for T13658
authorBen Gamari <ben@smart-cactus.org>
Tue, 16 May 2017 00:15:11 +0000 (20:15 -0400)
committerBen Gamari <ben@smart-cactus.org>
Tue, 16 May 2017 01:07:56 +0000 (21:07 -0400)
testsuite/tests/simplCore/should_compile/T13658.hs [new file with mode: 0644]
testsuite/tests/simplCore/should_compile/all.T

diff --git a/testsuite/tests/simplCore/should_compile/T13658.hs b/testsuite/tests/simplCore/should_compile/T13658.hs
new file mode 100644 (file)
index 0000000..0890e89
--- /dev/null
@@ -0,0 +1,39 @@
+{-# LANGUAGE TypeInType #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE BangPatterns #-}
+
+{- # OPTIONS_GHC -Werror #-}
+{-# OPTIONS_GHC -g -O2 #-}
+
+module Bug (bug) where
+
+-- import GHC.Base (seq)
+import Unsafe.Coerce (unsafeCoerce)
+
+undefined :: a
+undefined = undefined
+
+data TypeRep (a :: k) where
+    TrTyCon :: TypeRep (a :: k)
+    TrApp   :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
+               TypeRep (a b)
+
+data SomeTypeRep where
+    SomeTypeRep :: forall k (a :: k).
+                   TypeRep a
+                -> SomeTypeRep
+
+mkTrApp :: forall k1 k2 (a :: k1 -> k2) (b :: k1).
+           TypeRep (a :: k1 -> k2)
+        -> TypeRep (a b)
+mkTrApp TrTyCon = undefined
+mkTrApp TrApp   = undefined
+
+bug :: SomeTypeRep
+-- bug = f x -- this works
+bug = f (f x)
+  where x = SomeTypeRep TrTyCon
+        f :: SomeTypeRep -> SomeTypeRep
+        f (SomeTypeRep acc) = SomeTypeRep (mkTrApp (unsafeCoerce acc))
index b8a0c66..5ed520d 100644 (file)
@@ -268,3 +268,4 @@ test('T12600',
      normal,
      run_command,
      ['$MAKE -s --no-print-directory T12600'])
+test('T13658', normal, compile, ['-dcore-lint'])