[commit: ghc] wip/ttypeable: testsuite: Add test of Typeable Binary instances (009b607)

[git at git.haskell.org]

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

On branch  : wip/ttypeable
Link       : http://ghc.haskell.org/trac/ghc/changeset/009b60765d42ee62985af468ed7c643a46366438/ghc

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

commit 009b60765d42ee62985af468ed7c643a46366438
Author: Ben Gamari <ben at smart-cactus.org>
Date:   Fri Jul 22 13:13:36 2016 +0200

    testsuite: Add test of Typeable Binary instances


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

009b60765d42ee62985af468ed7c643a46366438
 .../typecheck/should_run/TestTypeableBinary.hs     | 37 ++++++++++++++++++++++
 .../typecheck/should_run/TestTypeableBinary.stdout | 15 +++++++++
 testsuite/tests/typecheck/should_run/all.T         |  1 +
 3 files changed, 53 insertions(+)

diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs
new file mode 100644
index 0000000..e427c13
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE PolyKinds #-}
+
+import qualified Data.ByteString as BS
+import Type.Reflection
+import Data.Binary
+import GHCi.TH.Binary ()
+
+import GHC.Exts
+import Data.Kind
+import Data.Proxy
+
+testRoundtrip :: Typeable a => TypeRep a -> IO ()
+testRoundtrip rep
+  | rep /= rep' = putStrLn $ "bad: " ++ show rep ++ " /= " ++ show rep'
+  | otherwise   = putStrLn $ "good: " ++ show rep
+  where
+    rep' = decode (encode rep)
+
+main :: IO ()
+main = do
+    testRoundtrip (typeRep :: TypeRep Int)
+    testRoundtrip (typeRep :: TypeRep Int#)
+    testRoundtrip (typeRep :: TypeRep IO)
+    testRoundtrip (typeRep :: TypeRep Maybe)
+    testRoundtrip (typeRep :: TypeRep TYPE)
+    testRoundtrip (typeRep :: TypeRep RuntimeRep)
+    testRoundtrip (typeRep :: TypeRep 'IntRep)
+    testRoundtrip (typeRep :: TypeRep (->))
+    testRoundtrip (typeRep :: TypeRep (Proxy Int))
+    testRoundtrip (typeRep :: TypeRep (Proxy Int#))
+    testRoundtrip (typeRep :: TypeRep Type)
+    testRoundtrip (typeRep :: TypeRep (Int -> Int))
+    testRoundtrip (typeRep :: TypeRep 5)
+    testRoundtrip (typeRep :: TypeRep "hello world")
+    testRoundtrip (typeRep :: TypeRep ('Just 5))
diff --git a/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
new file mode 100644
index 0000000..7e32096
--- /dev/null
+++ b/testsuite/tests/typecheck/should_run/TestTypeableBinary.stdout
@@ -0,0 +1,15 @@
+good: (Int)
+good: Int# :: ((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep)))
+good: IO :: ((*) -> (*))
+good: Maybe :: ((*) -> (*))
+good: TYPE :: ((RuntimeRep) -> (*))
+good: (RuntimeRep)
+good: 'IntRep :: (RuntimeRep)
+good: -> :: ((*) -> ((*) -> (*)))
+good: ((Proxy :: ((*) -> (*))) (Int))
+good: ((Proxy :: (((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep))) -> (*))) (Int# :: ((TYPE :: ((RuntimeRep) -> (*))) ('IntRep :: (RuntimeRep)))))
+good: (*)
+good: ((Int) -> (Int))
+good: 5 :: (Nat)
+good: "hello world" :: (Symbol)
+good: ('Just :: ((Nat) -> ((Maybe :: ((*) -> (*))) (Nat)))) (5 :: (Nat)) :: ((Maybe :: ((*) -> (*))) (Nat))
diff --git a/testsuite/tests/typecheck/should_run/all.T b/testsuite/tests/typecheck/should_run/all.T
index eab9f8a..9d4139e 100755
--- a/testsuite/tests/typecheck/should_run/all.T
+++ b/testsuite/tests/typecheck/should_run/all.T
@@ -117,3 +117,4 @@ test('KindInvariant', normal, ghci_script, ['KindInvariant.script'])
 test('StrictPats', normal, compile_and_run, [''])
 test('T12809', normal, compile_and_run, [''])
 test('EtaExpandLevPoly', normal, compile_and_run, [''])
+test('TestTypeableBinary', normal, compile_and_run, [''])