summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorShayne Fletcher <shayne@shaynefletcher.org>2020-12-01 12:27:43 -0500
committerBen Gamari <ben@smart-cactus.org>2020-12-15 20:10:03 -0500
commit0b9d2fe73aa8239fa2888c05d27bf421922335c7 (patch)
treea2d088daae98409e3b8fa230ab4d96790ff2ecca
parentd9064a7c3dfe5dc417f1d186f2e3b3977cce99ac (diff)
downloadhaskell-0b9d2fe73aa8239fa2888c05d27bf421922335c7.tar.gz
Fix bad span calculations of post qualified imports
(cherry picked from commit 57f3fdb1fbeb82b5b19bc5e2970d8857c2514fcc)
-rw-r--r--compiler/parser/Parser.y23
-rw-r--r--testsuite/tests/module/all.T1
-rw-r--r--testsuite/tests/module/mod185.hs5
-rw-r--r--testsuite/tests/module/mod185.stderr61
4 files changed, 82 insertions, 8 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index ded1711058..abec4c4d3f 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -973,18 +973,20 @@ importdecls_semi
importdecl :: { LImportDecl GhcPs }
: 'import' maybe_src maybe_safe optqualified maybe_pkg modid optqualified maybeas maybeimpspec
{% do {
- ; checkImportDecl $4 $7
- ; ams (cL (comb4 $1 $6 (snd $8) $9) $
+ ; let { ; mPreQual = unLoc $4
+ ; mPostQual = unLoc $7 }
+ ; checkImportDecl mPreQual mPostQual
+ ; ams (cL (comb5 $1 $6 $7 (snd $8) $9) $
ImportDecl { ideclExt = noExtField
, ideclSourceSrc = snd $ fst $2
, ideclName = $6, ideclPkgQual = snd $5
, ideclSource = snd $2, ideclSafe = snd $3
- , ideclQualified = importDeclQualifiedStyle $4 $7
+ , ideclQualified = importDeclQualifiedStyle mPreQual mPostQual
, ideclImplicit = False
, ideclAs = unLoc (snd $8)
, ideclHiding = unLoc $9 })
- (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList $4)
- ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList $7) ++ fst $8)
+ (mj AnnImport $1 : fst (fst $2) ++ fst $3 ++ fmap (mj AnnQualified) (maybeToList mPreQual)
+ ++ fst $5 ++ fmap (mj AnnQualified) (maybeToList mPostQual) ++ fst $8)
}
}
@@ -1008,9 +1010,9 @@ maybe_pkg :: { ([AddAnn],Maybe StringLiteral) }
; return ([mj AnnPackageName $1], Just (StringLiteral (getSTRINGs $1) pkgFS)) } }
| {- empty -} { ([],Nothing) }
-optqualified :: { Maybe (Located Token) }
- : 'qualified' { Just $1 }
- | {- empty -} { Nothing }
+optqualified :: { Located (Maybe (Located Token)) }
+ : 'qualified' { sL1 $1 (Just $1) }
+ | {- empty -} { noLoc Nothing }
maybeas :: { ([AddAnn],Located (Maybe (Located ModuleName))) }
: 'as' modid { ([mj AnnAs $1]
@@ -3896,6 +3898,11 @@ comb4 a b c d = a `seq` b `seq` c `seq` d `seq`
(combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
combineSrcSpans (getLoc c) (getLoc d))
+comb5 :: Located a -> Located b -> Located c -> Located d -> Located e -> SrcSpan
+comb5 a b c d e = a `seq` b `seq` c `seq` d `seq` e `seq`
+ (combineSrcSpans (getLoc a) $ combineSrcSpans (getLoc b) $
+ combineSrcSpans (getLoc c) $ combineSrcSpans (getLoc d) (getLoc e))
+
-- strict constructor version:
{-# INLINE sL #-}
sL :: HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
diff --git a/testsuite/tests/module/all.T b/testsuite/tests/module/all.T
index 2a26edb6e1..b94e8f3d07 100644
--- a/testsuite/tests/module/all.T
+++ b/testsuite/tests/module/all.T
@@ -268,6 +268,7 @@ test('mod181', normal, compile, [''])
test('mod182', normal, compile_fail, [''])
test('mod183', normal, compile_fail, [''])
test('mod184', normal, compile, ['-Wprepositive-qualified-module'])
+test('mod185', normal, compile, ['-ddump-parsed-ast'])
test('T1148', normal, compile, [''])
test('T1074', normal, compile, [''])
diff --git a/testsuite/tests/module/mod185.hs b/testsuite/tests/module/mod185.hs
new file mode 100644
index 0000000000..f1b9860b2e
--- /dev/null
+++ b/testsuite/tests/module/mod185.hs
@@ -0,0 +1,5 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+-- The span of the import decl should include the 'qualified' keyword.
+import Prelude qualified
+
+main = Prelude.undefined
diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr
new file mode 100644
index 0000000000..33e8374ef6
--- /dev/null
+++ b/testsuite/tests/module/mod185.stderr
@@ -0,0 +1,61 @@
+==================== Parser AST ====================
+
+({ mod185.hs:1:1 }
+ (HsModule
+ (Nothing)
+ (Nothing)
+ [({ mod185.hs:3:1-24 }
+ (ImportDecl
+ (NoExtField)
+ (NoSourceText)
+ ({ mod185.hs:3:8-14 }
+ {ModuleName: Prelude})
+ (Nothing)
+ (False)
+ (False)
+ (QualifiedPost)
+ (False)
+ (Nothing)
+ (Nothing)))]
+ [({ mod185.hs:5:1-24 }
+ (ValD
+ (NoExtField)
+ (FunBind
+ (NoExtField)
+ ({ mod185.hs:5:1-4 }
+ (Unqual
+ {OccName: main}))
+ (MG
+ (NoExtField)
+ ({ mod185.hs:5:1-24 }
+ [({ mod185.hs:5:1-24 }
+ (Match
+ (NoExtField)
+ (FunRhs
+ ({ mod185.hs:5:1-4 }
+ (Unqual
+ {OccName: main}))
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ (NoExtField)
+ [({ mod185.hs:5:6-24 }
+ (GRHS
+ (NoExtField)
+ []
+ ({ mod185.hs:5:8-24 }
+ (HsVar
+ (NoExtField)
+ ({ mod185.hs:5:8-24 }
+ (Qual
+ {ModuleName: Prelude}
+ {OccName: undefined}))))))]
+ ({ <no location info> }
+ (EmptyLocalBinds
+ (NoExtField))))))])
+ (FromSource))
+ (WpHole)
+ [])))]
+ (Nothing)
+ (Nothing)))