[commit: ghc] ghc-8.6: Check if files are same in combineSrcSpans (033d6ac)

git at git.haskell.org git at git.haskell.org
Tue Aug 21 22:57:02 UTC 2018


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

On branch  : ghc-8.6
Link       : http://ghc.haskell.org/trac/ghc/changeset/033d6ac775fad0aee9335169a41d19f54eee1486/ghc

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

commit 033d6ac775fad0aee9335169a41d19f54eee1486
Author: Zubin Duggal <zubin.duggal at gmail.com>
Date:   Sun Aug 12 15:51:29 2018 +0200

    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
    
    (cherry picked from commit f7f9820e8f5601e9a072e504f3d772fd78df6700)


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

033d6ac775fad0aee9335169a41d19f54eee1486
 compiler/basicTypes/SrcLoc.hs                        |  6 ++++--
 testsuite/tests/parser/should_compile/T15279.hs      |  7 +++++++
 testsuite/tests/parser/should_compile/T15279.hs-incl |  2 ++
 testsuite/tests/parser/should_compile/T15279.stderr  |  3 +++
 testsuite/tests/parser/should_compile/all.T          | 13 +++++++++++++
 5 files changed, 29 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/SrcLoc.hs b/compiler/basicTypes/SrcLoc.hs
index eeba3d7..3276f41 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 0000000..b80bd32
--- /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 0000000..d6385f2
--- /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 0000000..ff215a7
--- /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 1fd8c69..d949f2b 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, [''])



More information about the ghc-commits mailing list