diff options
| -rw-r--r-- | compiler/main/HeaderInfo.hs | 14 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/T10942.hs | 22 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/T10942.stdout | 1 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/T10942_A.hs | 16 | ||||
| -rw-r--r-- | testsuite/tests/ghc-api/all.T | 3 |
5 files changed, 56 insertions, 0 deletions
diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 08c761994a..35107c8bc3 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -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. diff --git a/testsuite/tests/ghc-api/T10942.hs b/testsuite/tests/ghc-api/T10942.hs new file mode 100644 index 0000000000..6fbf1d5bd3 --- /dev/null +++ b/testsuite/tests/ghc-api/T10942.hs @@ -0,0 +1,22 @@ +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)) diff --git a/testsuite/tests/ghc-api/T10942.stdout b/testsuite/tests/ghc-api/T10942.stdout new file mode 100644 index 0000000000..40ead27596 --- /dev/null +++ b/testsuite/tests/ghc-api/T10942.stdout @@ -0,0 +1 @@ +["-XFlexibleInstances","-XCPP"] diff --git a/testsuite/tests/ghc-api/T10942_A.hs b/testsuite/tests/ghc-api/T10942_A.hs new file mode 100644 index 0000000000..359961c8d9 --- /dev/null +++ b/testsuite/tests/ghc-api/T10942_A.hs @@ -0,0 +1,16 @@ +{- + +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 () diff --git a/testsuite/tests/ghc-api/all.T b/testsuite/tests/ghc-api/all.T index c4783ea15d..dee74b7e94 100644 --- a/testsuite/tests/ghc-api/all.T +++ b/testsuite/tests/ghc-api/all.T @@ -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']) |