[commit: testsuite] wip/T8541: Test coercing under under-saturated newtypes (49a978e)

[git at git.haskell.org]

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

On branch  : wip/T8541
Link       : http://ghc.haskell.org/trac/ghc/changeset/49a978e079b9007e23accc0ed927d8435fc9168e/testsuite

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

commit 49a978e079b9007e23accc0ed927d8435fc9168e
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Nov 19 12:15:30 2013 +0000

    Test coercing under under-saturated newtypes


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

49a978e079b9007e23accc0ed927d8435fc9168e
 tests/typecheck/should_run/TcCoercible.hs     |   20 ++++++++++++++------
 tests/typecheck/should_run/TcCoercible.stdout |    1 +
 2 files changed, 15 insertions(+), 6 deletions(-)

diff --git a/tests/typecheck/should_run/TcCoercible.hs b/tests/typecheck/should_run/TcCoercible.hs
index f5a3b97..4aa4ac1 100644
--- a/tests/typecheck/should_run/TcCoercible.hs
+++ b/tests/typecheck/should_run/TcCoercible.hs
@@ -15,26 +15,34 @@ data Map a b = Map a b deriving Show
 newtype List a = List [a] deriving Show
 data T f = T (f Int)
 
+-- It should be possible to coerce _under_ undersaturated newtypes
+newtype NonEtad a b = NonEtad (Either b a) deriving Show
+
+
+
 main = do
     print (coerce $ one                       :: Age)
-    print (coerce $ Age 1                     :: Int)
-    print (coerce $ Baz (Bar (Age 1))         :: Foo)
+    print (coerce $ age                       :: Int)
+    print (coerce $ Baz (Bar age)             :: Foo)
 
-    print (coerce (id::Bar->Bar) (Age 1)      :: Foo)
-    print (coerce Baz (Age 1)                 :: Foo)
-    print (coerce $ (Age 1, Foo (Age 1))      :: (Baz, Baz))
+    print (coerce (id::Bar->Bar) age          :: Foo)
+    print (coerce Baz age                     :: Foo)
+    print (coerce $ (Age 1, Foo age)          :: (Baz, Baz))
 
     print (coerce $ Map one one               :: Map Int Age)
 
     print (coerce $ Just one                  :: First Int)
     print (coerce $ (mempty :: Last Age)      :: Last Int)
 
-    printT (coerce $ (T (Left (Age 1)) :: T (Either Age))  :: T (Either Int))
+    printT (coerce $ (T (Left age)     :: T (Either Age))  :: T (Either Int))
     printT (coerce $ (T (Left one)     :: T (Either Int))  :: T (Either Age))
     printT (coerce $ (T [one]          :: T [])            :: T List)
     printT (coerce $ (T (List [one])   :: T List)          :: T [])
 
+    printT (coerce $ (T (NonEtad (Right age)) :: T (NonEtad Age)) :: T (NonEtad Int))
+
   where one = 1 :: Int
+        age = Age one
         printT (T x) = print x
 
 
diff --git a/tests/typecheck/should_run/TcCoercible.stdout b/tests/typecheck/should_run/TcCoercible.stdout
index 5c92bf4..6874804 100644
--- a/tests/typecheck/should_run/TcCoercible.stdout
+++ b/tests/typecheck/should_run/TcCoercible.stdout
@@ -11,3 +11,4 @@ Left 1
 Left (Age 1)
 List [1]
 [1]
+NonEtad (Right 1)