Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC Commits: c7061392 by mangoiv at 2025-12-05T16:27:42-05:00 driver: don't expect nodes to exist when checking paths between them In `mgQueryZero`, previously node lookups were expected to never fail, i.e. it was expected that when calculating the path between two nodes in a zero level import graph, both nodes would always exist. This is not the case, e.g. in some situations involving exact names (see the test-case). The fix is to first check whether the node is present in the graph at all, instead of panicking, just to report that there is no path. Closes #26568 - - - - - 4 changed files: - compiler/GHC/Unit/Module/Graph.hs - + testsuite/tests/th/T26568.hs - + testsuite/tests/th/T26568.stderr - testsuite/tests/th/all.T Changes: ===================================== compiler/GHC/Unit/Module/Graph.hs ===================================== @@ -565,16 +565,26 @@ mgReachableLoop mg nk = map summaryNodeSummary modules_below where allReachableMany td_map (mapMaybe lookup_node nk) --- | @'mgQueryZero' g root b@ answers the question: can we reach @b@ from @root@ +-- | @'mgQueryZero' g root target@ answers the question: can we reach @target@ from @root@ -- in the module graph @g@, only using normal (level 0) imports? +-- +-- If the @target@ key is not reachable, there is no path. +-- The @root@ key not being in @g@ results in a panic. mgQueryZero :: ModuleGraph -> ZeroScopeKey -> ZeroScopeKey -> Bool -mgQueryZero mg nka nkb = isReachable td_map na nb where +mgQueryZero mg rootKey targetKey = + case lookup_node targetKey of + -- The module we are looking for may not be in the module graph at all, + -- e.g. if a reference to it did not arise from an explicit import + -- declaration (as in #26568). + Nothing -> False + Just ntarget -> isReachable td_map nroot ntarget + where + -- invariant: the root key has to exist in the graph + nroot = fromJust $ lookup_node rootKey (td_map, lookup_node) = mg_zero_graph mg - na = expectJust $ lookup_node nka - nb = expectJust $ lookup_node nkb -- | Reachability Query. ===================================== testsuite/tests/th/T26568.hs ===================================== @@ -0,0 +1,7 @@ +{-# LANGUAGE ExplicitLevelImports, TemplateHaskell, NoImplicitPrelude #-} +module T16568 where + +x = $(do + _ <- _ + _) + ===================================== testsuite/tests/th/T26568.stderr ===================================== @@ -0,0 +1,34 @@ +T26568.hs:5:3: error: [GHC-28914] + • Level error: + instance for ‘GHC.Internal.Base.Monad GHC.Internal.TH.Monad.Q’ + is bound at levels {} but used at level -1 + • In a stmt of a 'do' block: _ <- _ + In the expression: + do _ <- _ + _ + In the untyped splice: + $(do _ <- _ + _) + +T26568.hs:5:8: error: [GHC-88464] + • Found hole: _ :: GHC.Internal.TH.Monad.Q a0 + Where: ‘a0’ is an ambiguous type variable + • In a stmt of a 'do' block: _ <- _ + In the expression: + do _ <- _ + _ + In the untyped splice: + $(do _ <- _ + _) + +T26568.hs:6:3: error: [GHC-88464] + • Found hole: + _ :: GHC.Internal.TH.Monad.Q GHC.Internal.TH.Syntax.Exp + • In a stmt of a 'do' block: _ + In the expression: + do _ <- _ + _ + In the untyped splice: + $(do _ <- _ + _) + ===================================== testsuite/tests/th/all.T ===================================== @@ -625,6 +625,7 @@ test('T25256', normal, compile_and_run, ['']) test('T24572a', normal, compile, ['']) test('T24572b', normal, compile_fail, ['']) test('T24572c', normal, compile_fail, ['']) +test('T26568', normal, compile_fail, ['']) test('T24572d', normal, compile, ['']) test('T25209', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('TH_MultilineStrings', normal, compile_and_run, ['']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7061392bf0c1bf1e1a2782035662763... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c7061392bf0c1bf1e1a2782035662763... You're receiving this email because of your account on gitlab.haskell.org.