[commit: ghc] master: Fix #14719 by using the setting the right SrcSpan (59fa7b3)

[git at git.haskell.org]

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

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

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

commit 59fa7b32b018a91f81773ca676251a0b2761ef56
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Fri Jan 26 13:10:26 2018 -0500

    Fix #14719 by using the setting the right SrcSpan
    
    Currently, error messages that germane to GADT constructors
    put the source span at only the first character in the constructor,
    leading to insufficient caret diagnostics. This can be easily fixed
    by using a source span that spans the entire constructor, instead of
    just the first character.
    
    Test Plan: make test TEST=T14719
    
    Reviewers: alanz, bgamari, simonpj
    
    Reviewed By: alanz, simonpj
    
    Subscribers: simonpj, goldfire, rwbarton, thomie, carter
    
    GHC Trac Issues: #14719
    
    Differential Revision: https://phabricator.haskell.org/D4344


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

59fa7b32b018a91f81773ca676251a0b2761ef56
 compiler/typecheck/TcTyClsDecls.hs     |  4 ++--
 testsuite/tests/gadt/T14719.hs         |  8 ++++++++
 testsuite/tests/gadt/T14719.stderr     | 18 ++++++++++++++++++
 testsuite/tests/gadt/all.T             |  1 +
 testsuite/tests/polykinds/T9222.stderr |  4 ++--
 5 files changed, 31 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index cd08570..7436b0d 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -2538,8 +2538,8 @@ checkValidTyConTyVars tc
 -------------------------------
 checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM ()
 checkValidDataCon dflags existential_ok tc con
-  = setSrcSpan (srcLocSpan (getSrcLoc con))     $
-    addErrCtxt (dataConCtxt con)                $
+  = setSrcSpan (getSrcSpan con)  $
+    addErrCtxt (dataConCtxt con) $
     do  { -- Check that the return type of the data constructor
           -- matches the type constructor; eg reject this:
           --   data T a where { MkT :: Bogus a }
diff --git a/testsuite/tests/gadt/T14719.hs b/testsuite/tests/gadt/T14719.hs
new file mode 100644
index 0000000..004116d
--- /dev/null
+++ b/testsuite/tests/gadt/T14719.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE GADTs #-}
+module T14719 where
+
+data Foo1 where
+  MkFoo1 :: Bool
+
+newtype Foo2 where
+  MkFoo2 :: Foo2
diff --git a/testsuite/tests/gadt/T14719.stderr b/testsuite/tests/gadt/T14719.stderr
new file mode 100644
index 0000000..cfac00c
--- /dev/null
+++ b/testsuite/tests/gadt/T14719.stderr
@@ -0,0 +1,18 @@
+
+T14719.hs:5:3: error:
+    • Data constructor ‘MkFoo1’ returns type ‘Bool’
+        instead of an instance of its parent type ‘Foo1’
+    • In the definition of data constructor ‘MkFoo1’
+      In the data type declaration for ‘Foo1’
+  |
+5 |   MkFoo1 :: Bool
+  |   ^^^^^^^^^^^^^^
+
+T14719.hs:8:3: error:
+    • The constructor of a newtype must have exactly one field
+        but ‘MkFoo2’ has none
+    • In the definition of data constructor ‘MkFoo2’
+      In the newtype declaration for ‘Foo2’
+  |
+8 |   MkFoo2 :: Foo2
+  |   ^^^^^^^^^^^^^^
diff --git a/testsuite/tests/gadt/all.T b/testsuite/tests/gadt/all.T
index c81ab80..59ec307 100644
--- a/testsuite/tests/gadt/all.T
+++ b/testsuite/tests/gadt/all.T
@@ -115,3 +115,4 @@ test('T9380', normal, compile_and_run, [''])
 test('T12087', normal, compile_fail, [''])
 test('T12468', normal, compile_fail, [''])
 test('T14320', normal, compile, [''])
+test('T14719', normal, compile_fail, ['-fdiagnostics-show-caret'])
diff --git a/testsuite/tests/polykinds/T9222.stderr b/testsuite/tests/polykinds/T9222.stderr
index 6e143e0..604cc1b 100644
--- a/testsuite/tests/polykinds/T9222.stderr
+++ b/testsuite/tests/polykinds/T9222.stderr
@@ -5,12 +5,12 @@ T9222.hs:13:3: error:
           inside the constraints: a ~ '(b0, c0)
           bound by the type of the constructor ‘Want’:
                      (a ~ '(b0, c0)) => Proxy b0
-          at T9222.hs:13:3
+          at T9222.hs:13:3-43
       ‘c’ is a rigid type variable bound by
         the type of the constructor ‘Want’:
           forall i1 j1 (a :: (i1, j1)) (b :: i1) (c :: j1).
           ((a ~ '(b, c)) => Proxy b) -> Want a
-        at T9222.hs:13:3
+        at T9222.hs:13:3-43
     • In the ambiguity check for ‘Want’
       To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
       In the definition of data constructor ‘Want’