diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs index 3f25bba6..bdf575fe 100644 --- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs +++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs @@ -313,12 +313,17 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports case mmn of Nothing -> (an, cs) Just (L l _) -> + -- We have a module name. Capture all comments up to the `where` + -- if no exports let (remaining, these) = - case entry l of - EpaSpan (RealSrcSpan s _) -> do - allocatePriorComments (ss2posEnd s) cs - _ -> (cs, []) + case mexports of + Just _ -> + case entry l of + EpaSpan (RealSrcSpan s _) -> do + allocatePriorComments (ss2posEnd s) cs + _ -> (cs, []) + Nothing -> splitOnWhere (<) (am_main $ anns an) cs (EpAnn a anno ocs) = an :: EpAnn AnnsModule anm = EpAnn a anno (workInComments ocs these) @@ -365,7 +370,7 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports (hc1,hc_cs) = if null ( am_main $ anns an3) then (hc0,[]) - else splitOnWhere (am_main $ anns an3) hc0 + else splitOnWhere (>) (am_main $ anns an3) hc0 hc2 = workInComments (comments an3) hc1 an4 = an3 { anns = (anns an3) {am_cs = hc_cs}, comments = hc2 } @@ -381,13 +386,13 @@ insertTopLevelCppComments (HsModule (XModulePs an lo mdeprec mbDoc) mmn mexports cs4' = workInComments cs4 these (xs',rest') = allocPreceding xs rest -splitOnWhere :: [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) -splitOnWhere [] csIn = (csIn,[]) -splitOnWhere (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc) +splitOnWhere :: (Pos -> Pos -> Bool) -> [AddEpAnn] -> [LEpaComment] -> ([LEpaComment], [LEpaComment]) +splitOnWhere _ [] csIn = (csIn,[]) +splitOnWhere f (AddEpAnn AnnWhere (EpaSpan (RealSrcSpan s _)):_) csIn = (hc, fc) where - (hc,fc) = break (\(L ll _) -> (ss2pos $ anchor ll) > (ss2pos s) ) csIn -splitOnWhere (AddEpAnn AnnWhere _:_) csIn = (csIn, []) -splitOnWhere (_:as) csIn = splitOnWhere as csIn + (hc,fc) = break (\(L ll _) -> f (ss2pos $ anchor ll) (ss2pos s)) csIn +splitOnWhere _ (AddEpAnn AnnWhere _:_) csIn = (csIn, []) +splitOnWhere f (_:as) csIn = splitOnWhere f as csIn balanceFirstLocatedAComments :: [LocatedA a] -> ([LocatedA a], [LEpaComment]) balanceFirstLocatedAComments [] = ([],[]) diff --git a/tests/Test.hs b/tests/Test.hs index 2f1493d2..e06ff8da 100644 --- a/tests/Test.hs +++ b/tests/Test.hs @@ -44,8 +44,8 @@ testDirs :: [FilePath] testDirs = case ghcVersion of GHC98 -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96"] - -- GHC910 -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96", "ghc98"] - GHC910 -> ["ghc910"] + GHC910 -> ["ghc710", "ghc80", "ghc82", "ghc84", "ghc86", "ghc88", "ghc810", "ghc90", "ghc92", "ghc94", "ghc96", "ghc98"] + -- GHC910 -> ["ghc910"] -- GHC910 -> ["ghc910-copied"] -- GHC910 -> ["ghc910", "ghc910-copied"] @@ -142,13 +142,13 @@ mkTests = do return $ TestList [ internalTests, roundTripTests - -- , - -- (transformTests libdir) - -- , (failingTests libdir) - -- , - -- roundTripBalanceCommentsTests - -- , - -- roundTripMakeDeltaTests + , + (transformTests libdir) + , (failingTests libdir) + , + roundTripBalanceCommentsTests + , + roundTripMakeDeltaTests ] failingTests :: LibDir -> Test @@ -200,9 +200,8 @@ tt' = do -- mkParserTest libdir "ghc910" "LinearLet.hs" -- mkParserTest libdir "ghc910" "Generic.hs" -- mkParserTest libdir "ghc910" "Expression.hs" - mkParserTest libdir "ghc910" "GenerateBug.hs" -- mkParserTest libdir "ghc910" "ConstructorArgs.hs" - -- mkParserTest libdir "ghc910" "T23927_2.hs" + mkParserTest libdir "ghc910" "P_IO_data.hs" -- Needs GHC changes diff --git a/tests/examples/ghc910/P_IO_data.hs b/tests/examples/ghc910/P_IO_data.hs index e262a988..5fe76f76 100644 --- a/tests/examples/ghc910/P_IO_data.hs +++ b/tests/examples/ghc910/P_IO_data.hs @@ -1 +1 @@ -module P_IO_data {- comment -} where +module P_IO_data {- c1 -} where