Check if files are same in combineSrcSpans

Summary: If this is not checked, SrcSpans are sometimes mangled by CPP.

Test Plan: ./validate

Reviewers: bgamari, dfeuer

Reviewed By: bgamari

Subscribers: dfeuer, rwbarton, thomie, carter

GHC Trac Issues: #15279

Differential Revision: https://phabricator.haskell.org/D4866

5 files changed, 29 insertions, 2 deletions

diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs
index eeba3d7be8..3276f41f14 100644
--- a/compiler/basicTypes/SrcLoc.hs
+++ b/compiler/basicTypes/SrcLoc.hs
@@ -307,12 +307,14 @@ mkSrcSpan (RealSrcLoc loc1) (RealSrcLoc loc2)
     = RealSrcSpan (mkRealSrcSpan loc1 loc2)
 
 -- | Combines two 'SrcSpan' into one that spans at least all the characters
--- within both spans. Assumes the "file" part is the same in both inputs
+-- within both spans. Returns UnhelpfulSpan if the files differ.
 combineSrcSpans :: SrcSpan -> SrcSpan -> SrcSpan
 combineSrcSpans (UnhelpfulSpan _) r = r -- this seems more useful
 combineSrcSpans l (UnhelpfulSpan _) = l
 combineSrcSpans (RealSrcSpan span1) (RealSrcSpan span2)
-    = RealSrcSpan (combineRealSrcSpans span1 span2)
+  | srcSpanFile span1 == srcSpanFile span2
+      = RealSrcSpan (combineRealSrcSpans span1 span2)
+  | otherwise = UnhelpfulSpan (fsLit "<combineSrcSpans: files differ>")
 
 -- | Combines two 'SrcSpan' into one that spans at least all the characters
 -- within both spans. Assumes the "file" part is the same in both inputs
diff --git a/testsuite/tests/parser/should_compile/T15279.hs b/testsuite/tests/parser/should_compile/T15279.hs
new file mode 100644
index 0000000000..b80bd32b54
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15279.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -ddump-parsed-ast #-}
+module T15279 where
+
+foo :: Char -> Char
+#include "T15279.hs-incl"
+foo _ = 'a'
diff --git a/testsuite/tests/parser/should_compile/T15279.hs-incl b/testsuite/tests/parser/should_compile/T15279.hs-incl
new file mode 100644
index 0000000000..d6385f28e3
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15279.hs-incl
@@ -0,0 +1,2 @@
+foo 'a' = 'b'
+foo 'b' = 'c'
diff --git a/testsuite/tests/parser/should_compile/T15279.stderr b/testsuite/tests/parser/should_compile/T15279.stderr
new file mode 100644
index 0000000000..ff215a763d
--- /dev/null
+++ b/testsuite/tests/parser/should_compile/T15279.stderr
@@ -0,0 +1,3 @@
+(MG
+(NoExt)
+({ <combineSrcSpans: files differ> }
diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T
index 1fd8c6924b..d949f2b42e 100644
--- a/testsuite/tests/parser/should_compile/all.T
+++ b/testsuite/tests/parser/should_compile/all.T
@@ -117,3 +117,16 @@ test('T13986', normal, compile, [''])
 test('T10855', normal, compile, [''])
 test('T15139', normal, compile, ['-Wincomplete-patterns -fdiagnostics-show-caret'])
 test('T15323', normal, compile, ['-dsuppress-uniques -ddump-parsed-ast'])
+
+def only_MG_loc(x):
+    """
+    Only compares the location embedded inside the MatchGroup, which has the form
+    (MG
+      (NoExt)
+      ({ <location>
+    """
+    ls = x.split("\n")
+    mgLocs = (loc.strip() for (mg,loc) in zip(ls,ls[2:])
+                if mg.strip().startswith("(MG"))
+    return '\n'.join(mgLocs)
+test('T15279', normalise_errmsg_fun(only_MG_loc), compile, [''])