[flang][Lower] Treat directives with nested evaluations as constructs

[kparzysz]

When generating block terminators in genFIR(Evaluation), treat Directives with nested evaluations the same way as Constructs to determine the successor block.

This fixes #91526

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

Author: Krzysztof Parzyszek (kparzysz)

Changes

When generating block terminators in genFIR(Evaluation), treat Directives with nested evaluations the same way as Constructs to determine the successor block.

This fixes #91526

---

Full diff: https://github.com/llvm/llvm-project/pull/91614.diff

2 Files Affected:

• (modified) flang/lib/Lower/Bridge.cpp (+7-3)
• (added) flang/test/Lower/branching-directive.f90 (+25)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 4902886712e92..79d6bbf65cbf7 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -4548,9 +4548,13 @@ class FirConverter : public Fortran::lower::AbstractConverter {
     // constructs, this can be done for either the end construct statement,
     // or for the construct itself, which will skip this code if the
     // end statement was visited first and generated a branch.
-    Fortran::lower::pft::Evaluation *successor =
-        eval.isConstruct() ? eval.getLastNestedEvaluation().lexicalSuccessor
-                           : eval.lexicalSuccessor;
+    Fortran::lower::pft::Evaluation *successor = [&]() {
+      if (eval.isConstruct() ||
+          (eval.isDirective() && eval.hasNestedEvaluations()))
+        return eval.getLastNestedEvaluation().lexicalSuccessor;
+      return eval.lexicalSuccessor;
+    }();
+
     if (successor && blockIsUnterminated()) {
       if (successor->isIntermediateConstructStmt() &&
           successor->parentConstruct->lowerAsUnstructured())
diff --git a/flang/test/Lower/branching-directive.f90 b/flang/test/Lower/branching-directive.f90
new file mode 100644
index 0000000000000..a0a147f1053a4
--- /dev/null
+++ b/flang/test/Lower/branching-directive.f90
@@ -0,0 +1,25 @@
+!RUN: flang-new -fc1 -emit-hlfir -fopenmp -o - %s | FileCheck %s
+
+!https://github.com/llvm/llvm-project/issues/91526
+
+!CHECK:   cf.cond_br %{{[0-9]+}}, ^bb[[THEN:[0-9]+]], ^bb[[ELSE:[0-9]+]]
+!CHECK: ^bb[[THEN]]:
+!CHECK:   cf.br ^bb[[EXIT:[0-9]+]]
+!CHECK: ^bb[[ELSE]]:
+!CHECK:   fir.call @_FortranAStopStatement
+!CHECK:   fir.unreachable
+!CHECK: ^bb[[EXIT]]:
+
+subroutine simple(y)
+  implicit none
+  logical, intent(in) :: y
+  integer :: i
+  if (y) then
+!$omp parallel
+    i = 1
+!$omp end parallel
+  else
+    stop 1
+  end if
+end subroutine simple
+

[vdonaldson]

Looks ok to me - thanks for the fix

[kiranchandramohan]

Thanks @kparzysz for fixing this quickly. My minor concern was whether this is only an isolated issue or whether there could be similar issues elsewhere that warrants a general solution. But since Val has approved, it is probably alrite.

If you could wait till tomorrow, @Leporacanthicus can check this on the application that hit the issue.

[vdonaldson]

I don't have the context for this PR. But if any OpenMP or other directive appears immediately before a CASE statement,or before an ELSE statement in an unstructured context, to give two examples, then this fix will be needed.

Ah yes! Chasing the issue link, there is an OpenMP directive followed by an ELSE statement in an unstructured context!

[Leporacanthicus]

I think this fix is doing something good - it helps in SOME cases, but perhaps not "good enough". I'm not opposed to this going in... But a complete fix would be better, in my (and Kiran's) opinion.

It doesn't fix my original problem, I'm still seeing the STOP when it shouldn't for this code:

subroutine simple(x, yn)
  implicit none
  logical, intent(in) :: yn
  integer, intent(in) :: x
  integer :: i
  real(8) :: E
  E = 0d0

  if (yn) then
     !$omp parallel do private(i) reduction(+:E)
     do i = 1, x
        E = E + i
     end do
     !$omp end parallel do
  else
     stop 1
  end if
  print *, E
end subroutine simple

program p

  integer :: xx
  xx = 50

  call simple(xx, .true.)
end program p

Compiler generates this MLIR (only the "interesting portion" shown here):

    cf.cond_br %8, ^bb1, ^bb2
  ^bb1:  // pred: ^bb0
    omp.parallel {
      %10 = fir.alloca i32 {adapt.valuebyref, pinned}
      %11 = fir.declare %10 {uniq_name = "_QFsimpleEi"} : (!fir.ref<i32>) -> !fir.ref<i32>
      %12 = fir.load %5 : !fir.ref<i32>
      omp.wsloop reduction(@add_reduction_f64 %2 -> %arg2 : !fir.ref<f64>) {
        omp.loop_nest (%arg3) : i32 = (%c1_i32) to (%12) inclusive step (%c1_i32) {
          %13 = fir.declare %arg2 {uniq_name = "_QFsimpleEe"} : (!fir.ref<f64>) -> !fir.ref<f64>
          fir.store %arg3 to %11 : !fir.ref<i32>
          %14 = fir.load %13 : !fir.ref<f64>
          %15 = fir.load %11 : !fir.ref<i32>
          %16 = fir.convert %15 : (i32) -> f64
          %17 = arith.addf %14, %16 fastmath<contract> : f64
          fir.store %17 to %13 : !fir.ref<f64>
          omp.yield
        }
        omp.terminator
      }
      omp.terminator
    }
    cf.br ^bb2
  ^bb2:  // 2 preds: ^bb0, ^bb1
    %9 = fir.call @_FortranAStopStatement(%c1_i32, %false, %false) fastmath<contract> : (i32, i1, i1) -> none
    fir.unreachable
  }

Not sure if it's because the parallel section has a do and/or a reduction inside it?

[kparzysz]

Yeah, this patch doesn't really fix the problem... I think we may need to revamp the block/branch generation. What I'm thinking is to generate empty blocks and linking (unconditional) branches early, and then fill them out in genFIR. For example, for a if/then/else statement we would insert branches from the "then" and the "else" blocks to the successor of the "if" statement right away. If the code inside of the then/else wants to insert its own terminator (like "unreachable" or something), then it would need to replace the existing one.

It seems to me like that should work, but maybe there are some special cases that would cause complications. What do you think?

[Leporacanthicus]

Yes, that sounds like it would work. I've spent a little bit of time today trying to come up with some easy fix, but that just led to a few hundred tests failing - and didn't really fix the issue either... :)

[razvanlupusoru]

The current implementation presented here resolves an issue I ran into:

subroutine acccase( var )
  integer ::  var
  integer :: res(10)
  select case ( var )
    case ( 1 )
      print *, "case 1"
      !$acc serial
      res(1) = 1
      !$acc end serial
    case ( 2 )
      print *, "case 2"
    case default
      print *, "case default"
  end select
end subroutine

The first iteration here, even if not perfect, is usable for some cases. I support the conversation on a more complete solution though - and seems to me that it can be done even if this first implementation is merged :) Thank you for looking into this!

[kiranchandramohan]

Agree. If it helps a known case this can go in and we can fix the general issue separately.

[vdonaldson]

Yes, this fix is necessary and useful. Please push.