diff options
| author | Ben Gamari <ben@smart-cactus.org> | 2019-12-10 13:43:32 -0500 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2019-12-10 13:45:45 -0500 |
| commit | 4f2620c09778d9ad0a85c527cbcec2d7c40bd55e (patch) | |
| tree | f74aaa8fa02cd3faacf367ad2baefa59cd65f023 | |
| parent | d46a72e19e1b508358827e7270139f3273915697 (diff) | |
| download | haskell-wip/T17561.tar.gz | |
parser: Correctly parse modules starting with declaration-and-docstringwip/T17561
Previously the module header parser would start by parsing a
maybedocheader. This would consume the docstring and commit us to
parsing a `module ... where` header. However, a module lacking a `module
... where` header may also begin with a docstring, but one rather
belonging to a declaration. Restructure the parser to ensure that this
case is handled correctly.
Fixes #17561.
| -rw-r--r-- | compiler/parser/Parser.y | 13 | ||||
| -rw-r--r-- | testsuite/tests/parser/should_compile/T17561.hs | 3 | ||||
| -rw-r--r-- | testsuite/tests/parser/should_compile/all.T | 1 |
3 files changed, 15 insertions, 2 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index ce4d277f6b..7c520d0bd8 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -766,13 +766,22 @@ signature :: { Located (HsModule GhcPs) } ([mj AnnSignature $2, mj AnnWhere $6] ++ fst $7) } module :: { Located (HsModule GhcPs) } - : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body + -- it is important that we include both rules below and not use + -- maybedocheader here since we may have a module which begins with a + -- declaration with docstring (see #17561). + : moduleheader 'module' modid maybemodwarning maybeexports 'where' body {% fileSrcSpan >>= \ loc -> ams (L loc (HsModule (Just $3) $5 (fst $ snd $7) (snd $ snd $7) $4 $1) ) ([mj AnnModule $2, mj AnnWhere $6] ++ fst $7) } - | body2 + | 'module' modid maybemodwarning maybeexports 'where' body + {% fileSrcSpan >>= \ loc -> + ams (L loc (HsModule (Just $2) $4 (fst $ snd $6) + (snd $ snd $6) $3 Nothing) + ) + ([mj AnnModule $1, mj AnnWhere $5] ++ fst $6) } + | body2 {% fileSrcSpan >>= \ loc -> ams (L loc (HsModule Nothing Nothing (fst $ snd $1) (snd $ snd $1) Nothing Nothing)) diff --git a/testsuite/tests/parser/should_compile/T17561.hs b/testsuite/tests/parser/should_compile/T17561.hs new file mode 100644 index 0000000000..caddabfbe4 --- /dev/null +++ b/testsuite/tests/parser/should_compile/T17561.hs @@ -0,0 +1,3 @@ +-- | Test whether @-haddock@ mode parses a module lacking a module header +-- correctly . +hello = 42 diff --git a/testsuite/tests/parser/should_compile/all.T b/testsuite/tests/parser/should_compile/all.T index 85a7c3c172..21b7412e19 100644 --- a/testsuite/tests/parser/should_compile/all.T +++ b/testsuite/tests/parser/should_compile/all.T @@ -164,3 +164,4 @@ test('proposal-229f', multimod_compile_and_run, ['proposal-229f.hs', '']) test('T15730a', normal, compile_and_run, ['']) +test('T17561', normal, compile_and_run, ['-haddock']) |