Commit 5d6133be authored by Matthew Pickering's avatar Matthew Pickering Committed by Ben Gamari

Ignore comments in getOptions

When Opt_KeepRawTokenStream is turned on then getOptions fails to find
the language pragmas which can cause unexpected parse errors when using
the GHC API. A simple solution is to make it skip over any comments in
the token
stream.

Test Plan: ./validate

Reviewers: austin, bgamari

Subscribers: alanz, thomie

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

GHC Trac Issues: #10942
parent ac2e1e57
......@@ -256,6 +256,9 @@ getOptions' dflags toks
parseToks (open:xs)
| ITlanguage_prag <- getToken open
= parseLanguage xs
parseToks (comment:xs) -- Skip over comments
| isComment (getToken comment)
= parseToks xs
parseToks _ = []
parseLanguage (L loc (ITconid fs):rest)
= checkExtension dflags (L loc fs) :
......@@ -269,6 +272,17 @@ getOptions' dflags toks
parseLanguage []
= panic "getOptions'.parseLanguage(2) went past eof token"
isComment :: Token -> Bool
isComment c =
case c of
(ITlineComment {}) -> True
(ITblockComment {}) -> True
(ITdocCommentNext {}) -> True
(ITdocCommentPrev {}) -> True
(ITdocCommentNamed {}) -> True
(ITdocSection {}) -> True
_ -> False
-----------------------------------------------------------------------------
-- | Complain about non-dynamic flags in OPTIONS pragmas.
......
module Main where
import DynFlags
import GHC
import Control.Monad.IO.Class (liftIO)
import System.Environment
import HeaderInfo
import Outputable
import StringBuffer
main :: IO ()
main = do
[libdir] <- getArgs
runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
let dflags' = dflags `gopt_set` Opt_KeepRawTokenStream
`gopt_set` Opt_Haddock
filename = "T10942_A.hs"
setSessionDynFlags dflags'
stringBuffer <- liftIO $ hGetStringBuffer filename
liftIO $ print (map unLoc (getOptions dflags' stringBuffer filename))
["-XFlexibleInstances","-XCPP"]
{-
A normal comment, to check if we can still pick up the CPP directive after it.
-}
-- Check that we can parse a file with leading comments
-- ^ haddock
-- * haddock
-- | haddock
-- $ haddock
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE CPP #-}
module T10942 where
main = return ()
......@@ -14,3 +14,6 @@ test('T9595', extra_run_opts('"' + config.libdir + '"'),
test('T10508_api', extra_run_opts('"' + config.libdir + '"'),
compile_and_run,
['-package ghc'])
test('T10942', extra_run_opts('"' + config.libdir + '"'),
compile_and_run,
['-package ghc'])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment