[commit: ghc] master: Test Trac #9380 (dc7d3c2)

[git at git.haskell.org]

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

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

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

commit dc7d3c2d437b310d26b05033d1b34601e1914d00
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jul 31 13:48:46 2014 +0100

    Test Trac #9380


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

dc7d3c2d437b310d26b05033d1b34601e1914d00
 testsuite/tests/gadt/T9380.hs     | 68 +++++++++++++++++++++++++++++++++++++++
 testsuite/tests/gadt/T9380.stdout |  3 ++
 testsuite/tests/gadt/all.T        |  1 +
 3 files changed, 72 insertions(+)

diff --git a/testsuite/tests/gadt/T9380.hs b/testsuite/tests/gadt/T9380.hs
new file mode 100644
index 0000000..ebc0217
--- /dev/null
+++ b/testsuite/tests/gadt/T9380.hs
@@ -0,0 +1,68 @@
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE GADTs #-}
+module Main where
+
+import Foreign
+import Unsafe.Coerce
+
+data M = A | B deriving (Show, Eq)
+
+newtype S (a :: M) = S Int
+
+data SomeS = forall a . SomeS (S a)
+
+data V0 :: M -> * where
+  V0A :: Int -> V0 A
+  V0B :: Double -> V0 B
+
+data V1 :: M -> * where
+  V1A :: Int -> V1 A
+  V1B :: Double -> V1 B
+  V1a :: () -> V1 a
+
+viewV0 :: S a -> V0 a
+viewV0 (S i)
+  | even i = unsafeCoerce $ V0A 1
+  | otherwise = unsafeCoerce $ V0B 2
+
+viewV1 :: S a -> V1 a
+viewV1 (S i)
+  | even i = unsafeCoerce $ V1A 1
+  | otherwise = unsafeCoerce $ V1B 2
+
+
+typeOf :: S a -> M
+typeOf (S i) = if even i then A else B
+
+cast :: M -> SomeS -> S a
+cast ty (SomeS s@(S i))
+  | ty == typeOf s = S i
+  | otherwise = error "cast"
+
+test0 :: IO ()
+test0 =
+  let s = cast A (SomeS (S 0))
+  in case viewV0 s of
+       V0A{} -> putStrLn "test0 - A"
+       V0B{} -> putStrLn "test0 - B"
+
+test1 :: IO ()
+test1 =
+  let s = cast A (SomeS (S 2)) :: S A
+  in case viewV0 s of
+      V0A{} -> putStrLn "test1 - A"
+
+test2 :: IO ()
+test2 =
+  let s = cast A (SomeS (S 4))
+  in case viewV1 s of
+      V1A{} -> putStrLn "test2 - A"
+      V1B{} -> putStrLn "test2 - B"
+      V1a{} -> putStrLn "test2 - O_o"
+
+main = do
+  test0 -- no ouput at all
+  test1 -- A
+  test2 -- O_o
\ No newline at end of file
diff --git a/testsuite/tests/gadt/T9380.stdout b/testsuite/tests/gadt/T9380.stdout
new file mode 100644
index 0000000..0a5a466
--- /dev/null
+++ b/testsuite/tests/gadt/T9380.stdout
@@ -0,0 +1,3 @@
+test0 - A
+test1 - A
+test2 - A
diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index 52a8812..4a42bb7 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/tests/gadt/all.T
@@ -123,3 +123,4 @@ test('T7321',
 test('T7974', normal, compile, [''])
 test('T7558', normal, compile_fail, [''])
 test('T9096', normal, compile, [''])
+test('T9380', normal, compile_and_run, [''])