Check if files are same in combineSrcSpans
authorZubin Duggal <zubin.duggal@gmail.com>
Sun, 12 Aug 2018 13:51:29 +0000 (15:51 +0200)
committerKrzysztof Gogolewski <krz.gogolewski@gmail.com>
Sun, 12 Aug 2018 13:52:19 +0000 (15:52 +0200)
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

compiler/basicTypes/SrcLoc.hs
testsuite/tests/parser/should_compile/T15279.hs [new file with mode: 0644]
testsuite/tests/parser/should_compile/T15279.hs-incl [new file with mode: 0644]
testsuite/tests/parser/should_compile/T15279.stderr [new file with mode: 0644]
testsuite/tests/parser/should_compile/all.T

index eeba3d7..3276f41 100644 (file)
@@ -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 (file)
index 0000000..b80bd32
--- /dev/null
@@ -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 (file)
index 0000000..d6385f2
--- /dev/null
@@ -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 (file)
index 0000000..ff215a7
--- /dev/null
@@ -0,0 +1,3 @@
+(MG
+(NoExt)
+({ <combineSrcSpans: files differ> }
index 1fd8c69..d949f2b 100644 (file)
@@ -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, [''])