genBackEdgeMap: Convert to BackEdgeMap only after filtering for dominance.

Conversion to BackEdgeMap too soon screws up one-to-many nodes, since it is a
one-to-one map. This wasn't a problem in the past because of the way we
translated loops into AST, the 'continue' basic block was always a 1-entrance,
1-exit deal. But now it is possible for a do-loop to be translated into a
single basic block with multiple exits, so the bug is triggered.

Author: mrd

src/Language/Fortran/Analysis/DataFlow.hs

@@ -325,9 +325,9 @@ type BackEdgeMap = IM.IntMap Node
 -- target node dominates the source node. If the backedges are viewed
 -- as (m -> n) then n is considered the 'loop-header'
 genBackEdgeMap :: Graph gr => DomMap -> gr a b -> BackEdgeMap
-genBackEdgeMap domMap = IM.filterWithKey isBackEdge . IM.fromList . edges
+genBackEdgeMap domMap = IM.fromList . filter isBackEdge . edges
   where
-    isBackEdge s t = t `IS.member` (fromJustMsg "genBackEdgeMap" $ s `IM.lookup` domMap)
+    isBackEdge (s, t) = t `IS.member` (fromJustMsg "genBackEdgeMap" $ s `IM.lookup` domMap)
 
 -- | For each loop in the program, find out which bblock nodes are
 -- part of the loop by looking through the backedges (m, n) where n is

test/Language/Fortran/Analysis/DataFlowSpec.hs

@@ -178,6 +178,15 @@ spec =
         let ivMap  = genInductionVarMapByASTBlock bedges gr
         (sort . map (\ x -> (head x, length x)) . group . sort . map S.size $ IM.elems ivMap) `shouldBe` [(1,3),(2,3)]
 
+    describe "bug36" $ do
+      let pf = pParser F90 programBug36
+      let sgr = genSuperBBGr (genBBlockMap pf)
+      let gr = superBBGrGraph sgr
+      let domMap = dominators gr
+      let bedges = genBackEdgeMap domMap gr
+      it "loopNodes" $ do
+        length (loopNodes bedges gr) `shouldBe` 2
+
 --------------------------------------------------
 -- Label-finding helper functions to help write tests that are
 -- insensitive to minor changes to the AST.
@@ -315,6 +324,20 @@ programRd4 = unlines [
     , ""
     ]
 
+-- do not use line numbers
+programBug36 = unlines [
+      "program foo"
+    , "  implicit none"
+    , "  integer :: i, j"
+    , "  real, dimension(100) :: a, b"
+    , "  do i=1,100"
+    , "     do j=1,100"
+    , "      a(i) = b(i) + b(1)"
+    , "     end do"
+    , "  end do"
+    , "end program"
+    ]
+
 -- Local variables:
 -- mode: haskell
 -- haskell-program-name: "cabal repl test-suite:spec"