diff options
author | wz1000 <zubin.duggal@gmail.com> | 2021-10-11 15:40:19 +0530 |
---|---|---|
committer | GitHub <noreply@github.com> | 2021-10-11 12:10:19 +0200 |
commit | a33e376531a4f478bacd41fc3028985405b8c164 (patch) | |
tree | dde32ed6fcf5728c77ac72ceb6ca90962e654c82 /haddock-api/src/Haddock/Backends | |
parent | 1b63771dee5a7fac0696505d0b335908bd12835d (diff) |
Enable Haddock tests in GHC windows CI (#1428)
* testsuite: strip windows line endings for haddock
* hyperlinker: Work around double escaping (#19236)
* deterministic SCC
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker.hs | 12 |
1 files changed, 10 insertions, 2 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker.hs b/haddock-api/src/Haddock/Backends/Hyperlinker.hs index 39be6762..68e03fd5 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker.hs @@ -22,7 +22,7 @@ import System.FilePath import GHC.Iface.Ext.Types ( pattern HiePath, HieFile(..), HieASTs(..), HieAST(..), SourcedNodeInfo(..) ) import GHC.Iface.Ext.Binary ( readHieFile, hie_file_result ) -import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc ) +import GHC.Types.SrcLoc ( realSrcLocSpan, mkRealSrcLoc, srcSpanFile ) import Data.Map as M import GHC.Data.FastString ( mkFastString ) import GHC.Unit.Module ( Module, moduleName ) @@ -71,7 +71,7 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile let fileFs = mkFastString file mast | M.size asts == 1 = snd <$> M.lookupMin asts | otherwise = M.lookup (HiePath (mkFastString file)) asts - tokens = parse df file rawSrc + tokens' = parse df file rawSrc ast = fromMaybe (emptyHieAst fileFs) mast fullAst = recoverFullIfaceTypes df types ast @@ -81,6 +81,14 @@ ppHyperlinkedModuleSource verbosity srcdir pretty srcs iface = case ifaceHieFile else out verbosity verbose $ unwords [ "couldn't find ast for" , file, show (M.keys asts) ] + -- The C preprocessor can double the backslashes on tokens (see #19236), + -- which means the source spans will not be comparable and we will not + -- be able to associate the HieAST with the correct tokens. + -- + -- We work around this by setting the source span of the tokens to the file + -- name from the HieAST + let tokens = fmap (\tk -> tk {tkSpan = (tkSpan tk){srcSpanFile = srcSpanFile $ nodeSpan fullAst}}) tokens' + -- Produce and write out the hyperlinked sources writeUtf8File path . renderToString pretty . render' fullAst $ tokens Nothing -> return () |