[commit: ghc] wip/hasfield: Basic tests for HasField constraint solving (c9f8c92)

[git at git.haskell.org]

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

On branch  : wip/hasfield
Link       : http://ghc.haskell.org/trac/ghc/changeset/c9f8c927fb2f74b4fa4e60487167922b357e89a5/ghc

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

commit c9f8c927fb2f74b4fa4e60487167922b357e89a5
Author: Adam Gundry <adam at well-typed.com>
Date:   Tue Dec 22 16:23:40 2015 +0000

    Basic tests for HasField constraint solving


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

c9f8c927fb2f74b4fa4e60487167922b357e89a5
 .../overloadedrecflds/should_fail/HasFieldFail01_A.hs   |  3 +++
 testsuite/tests/overloadedrecflds/should_fail/all.T     |  3 +++
 .../overloadedrecflds/should_fail/hasfieldfail01.hs     | 10 ++++++++++
 .../overloadedrecflds/should_fail/hasfieldfail01.stderr | 12 ++++++++++++
 testsuite/tests/overloadedrecflds/should_run/all.T      |  1 +
 .../tests/overloadedrecflds/should_run/hasfieldrun01.hs | 17 +++++++++++++++++
 ...erloadedrecfldsrun06.stdout => hasfieldrun01.stdout} |  1 +
 7 files changed, 47 insertions(+)

diff --git a/testsuite/tests/overloadedrecflds/should_fail/HasFieldFail01_A.hs b/testsuite/tests/overloadedrecflds/should_fail/HasFieldFail01_A.hs
new file mode 100644
index 0000000..f7dc113
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/HasFieldFail01_A.hs
@@ -0,0 +1,3 @@
+module HasFieldFail01_A where
+
+data T = MkT { foo :: Int }
diff --git a/testsuite/tests/overloadedrecflds/should_fail/all.T b/testsuite/tests/overloadedrecflds/should_fail/all.T
index 3626405..9f5b780 100644
--- a/testsuite/tests/overloadedrecflds/should_fail/all.T
+++ b/testsuite/tests/overloadedrecflds/should_fail/all.T
@@ -30,3 +30,6 @@ test('T11167_ambiguous_fixity',
      extra_clean([ 'T11167_ambiguous_fixity_A.hi', 'T11167_ambiguous_fixity_A.o'
                  , 'T11167_ambiguous_fixity_B.hi', 'T11167_ambiguous_fixity_B.o' ]),
      multimod_compile_fail, ['T11167_ambiguous_fixity', ''])
+test('hasfieldfail01',
+     extra_clean(['HasFieldFail01_A.hi', 'HasFieldFail01_A.o']),
+     multimod_compile_fail, ['hasfieldfail01', ''])
diff --git a/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs
new file mode 100644
index 0000000..0e611d6
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE DataKinds, MagicHash, TypeFamilies #-}
+
+import HasFieldFail01_A (T(MkT))
+
+import GHC.Prim (Proxy#, proxy#)
+import GHC.Records (HasField(..))
+
+-- This should fail to solve the HasField constraint, because foo is
+-- not in scope.
+main = print (getField (proxy# :: Proxy# "foo") (MkT 42) :: Int)
diff --git a/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr
new file mode 100644
index 0000000..d2623d8
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_fail/hasfieldfail01.stderr
@@ -0,0 +1,12 @@
+[1 of 2] Compiling HasFieldFail01_A ( HasFieldFail01_A.hs, HasFieldFail01_A.o )
+[2 of 2] Compiling Main             ( hasfieldfail01.hs, hasfieldfail01.o )
+
+hasfieldfail01.hs:10:15: error:
+    • No instance for (HasField "foo" T Int)
+        arising from a use of ‘getField’
+    • In the first argument of ‘print’, namely
+        ‘(getField (proxy# :: Proxy# "foo") (MkT 42) :: Int)’
+      In the expression:
+        print (getField (proxy# :: Proxy# "foo") (MkT 42) :: Int)
+      In an equation for ‘main’:
+          main = print (getField (proxy# :: Proxy# "foo") (MkT 42) :: Int)
diff --git a/testsuite/tests/overloadedrecflds/should_run/all.T b/testsuite/tests/overloadedrecflds/should_run/all.T
index 019a1ef..1e0787e 100644
--- a/testsuite/tests/overloadedrecflds/should_run/all.T
+++ b/testsuite/tests/overloadedrecflds/should_run/all.T
@@ -15,3 +15,4 @@ test('overloadedlabelsrun03', normal, compile_and_run, [''])
 test('overloadedlabelsrun04',
      extra_clean(['OverloadedLabelsRun04_A.hi', 'OverloadedLabelsRun04_A.o']),
      multimod_compile_and_run, ['overloadedlabelsrun04', ''])
+test('hasfieldrun01', normal, compile_and_run, [''])
diff --git a/testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs
new file mode 100644
index 0000000..0f27c6b
--- /dev/null
+++ b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE DataKinds, MagicHash, TypeFamilies #-}
+
+import GHC.Prim (Proxy#, proxy#)
+import GHC.Records (getField)
+
+type family B where B = Bool
+
+data T = MkT { foo :: Int, bar :: B }
+
+data U a b = MkU { baf :: a }
+
+t = MkT 42 True
+u = MkU 'x'
+
+main = do print (getField (proxy# :: Proxy# "foo") t)
+          print (getField (proxy# :: Proxy# "bar") t)
+          print (getField (proxy# :: Proxy# "baf") u)
diff --git a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout
similarity index 66%
copy from testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout
copy to testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout
index abc4e3b..1bfbe7a 100644
--- a/testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun06.stdout
+++ b/testsuite/tests/overloadedrecflds/should_run/hasfieldrun01.stdout
@@ -1,2 +1,3 @@
 42
 True
+'x'