Commit ea751248 authored by Douglas Wilson's avatar Douglas Wilson Committed by Ben Gamari
Browse files

Fix logic error in GhcMake.enableCodeGenForTH

transitive_deps_set was incorrect, it was not considering the
dependencies of dependencies in some cases. I've corrected it and tidied
it up a little.

The test case from leftaroundabout, as linked to from the ticket, is
added with small modifications to flatten directory structure.

Test Plan: make test TEST=T13949

Reviewers: austin, bgamari, alexbiehl

Reviewed By: alexbiehl

Subscribers: rwbarton, thomie, alexbiehl

GHC Trac Issues: #13949

Differential Revision: https://phabricator.haskell.org/D3720
parent abda03be
......@@ -1994,27 +1994,32 @@ enableCodeGenForTH target nodemap =
, ms_hspp_opts = updOptLevel 0 $ dflags {hscTarget = target}
}
| otherwise = return ms
needs_codegen_set = transitive_deps_set Set.empty th_modSums
th_modSums =
needs_codegen_set = transitive_deps_set
[ ms
| mss <- Map.elems nodemap
, Right ms <- mss
, needsTemplateHaskellOrQQ $ [ms]
]
transitive_deps_set marked_mods modSums = foldl' go marked_mods modSums
go marked_mods ms
| Set.member (ms_mod ms) marked_mods = marked_mods
| otherwise =
let deps =
[ dep_ms
| (L _ mn, NotBoot) <- msDeps ms
, dep_ms <-
toList (Map.lookup (mn, NotBoot) nodemap) >>= toList >>=
toList
]
new_marked_mods =
marked_mods `Set.union` Set.fromList (fmap ms_mod deps)
in transitive_deps_set new_marked_mods deps
-- find the set of all transitive dependencies of a list of modules.
transitive_deps_set modSums = foldl' go Set.empty modSums
where
go marked_mods ms@ModSummary{ms_mod}
| ms_mod `Set.member` marked_mods = marked_mods
| otherwise =
let deps =
[ dep_ms
-- If a module imports a boot module, msDeps helpfully adds a
-- dependency to that non-boot module in it's result. This
-- means we don't have to think about boot modules here.
| (L _ mn, NotBoot) <- msDeps ms
, dep_ms <-
toList (Map.lookup (mn, NotBoot) nodemap) >>= toList >>=
toList
]
new_marked_mods = Set.insert ms_mod marked_mods
in foldl' go new_marked_mods deps
mkRootMap :: [ModSummary] -> NodeMap [Either ErrMsg ModSummary]
mkRootMap summaries = Map.insertListWith (flip (++))
......
{-# LANGUAGE TemplateHaskell #-}
module ASCII () where
import Tree
import PatternGenerator
type EP g = Bool
templateFoo ''EP ['A'..'Z']
TOP=../../../..
include $(TOP)/mk/boilerplate.mk
include $(TOP)/mk/test.mk
module PatternGenerator where
import Tree
import Language.Haskell.TH
templateFoo :: Name -> [Char] -> DecsQ
templateFoo _ _ = return []
module These where
tuc :: t (k, a)
tuc = undefined
module Tree where
import These
mp :: Maybe (Int, ())
mp = tuc
test('T13949', extra_files(['ASCII.hs', 'PatternGenerator.hs', 'These.hs', 'Tree.hs']),
multimod_compile, ['ASCII PatternGenerator These Tree', '-fno-code -v0'])
\ No newline at end of file
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