[Flang] Fix nested block constructs for SELECT CASE

[cseo]

Summary

In some scenarios, a SELECT CASE could cause an error while lowering to FIR.
This was caused by a spurious extra branch added after the end statement. A
new test was added so this doesn't regress in the future.

Fixes #62726

[luporl]

flang/lib/Lower/Bridge.cpp

3859

Does checking for blockIsUnterminated() here work too, instead of using getIf()?
I'm not familiar with this code, but if the issue is being caused by successor->parentConstruct->lowerAsUnstructured() adding a terminator to the current block, then maybe checking for block termination may also catch other potential issues.

flang/test/Lower/select-case-statement.f90

431

CHECK is missing a colon.

Maybe the branches to bb7 could also be checked, for more context?

[cseo]

flang/lib/Lower/Bridge.cpp

3859

This check is already being done in the topmost if.

flang/test/Lower/select-case-statement.f90

431

Ack.

[luporl]

flang/lib/Lower/Bridge.cpp

3859

I thought lowerAsUnstructured() would try to lower the parentConstruct, but now I see it's not the case, so nevermind.

[cseo]

Added extra checks to select-case-statement.f90

Fixed the missing colon and added extra checks for 'end select'.

[vdonaldson]

Thanks @cseo for looking at this bug.

Most construct END statements do not have any associated code. That changed fairly recently to support finalization and deallocation code where needed. That includes deallocation of a character SELECT CASE trim(str) selector expression result, as here.

End-of-construct processing could be associated with an END construct statement (an EndSelectStmt here), or with the end of the construct itself (a CaseConstruct here). The two views must agree on which does what. Some other constructs already do this correctly. As with other cases, I recommend fixing the problem in construct code, rather than generic genFIR code. Something like the following, where the second set of diffs is for the genFIR SelectTypeConstruct function, which is also at risk for the same problem.

(It may be worth noting that SELECT statements are always unstructured in the FIR sense.)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index c1dbac108b88..f1c93ccf5df8 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -1823,12 +1823,17 @@ private:

   void genFIR(const Fortran::parser::CaseConstruct &) {
     Fortran::lower::pft::Evaluation &eval = getEval();
     Fortran::lower::StatementContext stmtCtx;
     pushActiveConstruct(eval, stmtCtx);
-    for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations())
-      genFIR(e);
+    for (Fortran::lower::pft::Evaluation &e :
+         getEval().getNestedEvaluations()) {
+      if (e.getIf<Fortran::parser::EndSelectStmt>())
+        maybeStartBlock(e.block);
+      else
+        genFIR(e);
+    }
     popActiveConstruct();
   }

   template <typename A>
   void genNestedStatement(const Fortran::parser::Statement<A> &stmt) {
@@ -2684,11 +2689,11 @@ private:
           }
         }
         builder->restoreInsertionPoint(crtInsPt);
         ++typeGuardIdx;
       } else if (eval.getIf<Fortran::parser::EndSelectStmt>()) {
-        genFIR(eval);
+        maybeStartBlock(eval.block);
         if (hasLocalScope)
           localSymbols.popScope();
       } else {
         genFIR(eval);
       }

[cseo]

In D151118#4362665, @vdonaldson wrote:

I recommend fixing the problem in construct code, rather than generic genFIR code. Something like the following, where the second set of diffs is for the genFIR SelectTypeConstruct function, which is also at risk for the same problem.

I see, makes sense. Thanks, I'll take a look and submit a new revision.

[cseo]

Moved the fix from the generic genFIR code to SelectTypeConstruct/CaseConstruct

[vdonaldson]

Looks good to me, thanks for addressing this!

flang/test/Lower/select-case-statement.f90

429

Exact ssa values such as %14 can be fragile, because ssa values could be deleted or inserted due to other arbitrary code changes. An unrelated mismatch can be avoided in this case by substituting %{{[0-9]+}} to match any valid ssa value here.

[cseo]

flang/test/Lower/select-case-statement.f90

429

True. Forgot about this hardcoded value from my tests. Thanks for catching it.

[cseo]

@vdonaldson btw, I don't have commit access. So, whenever you think this change is good to go, feel free to push it.

[vdonaldson]

In D151118#4368244, @cseo wrote:

@vdonaldson btw, I don't have commit access. So, whenever you think this change is good to go, feel free to push it.

@cseo The preferred approach is to request commit access: obtaining-commit-access

(Don't forget to update the test details!)

[cseo]

Updated the testcase to remove a hardcoded SSA register variable.

[cseo]

In D151118#4368717, @vdonaldson wrote:

In D151118#4368244, @cseo wrote:

@vdonaldson btw, I don't have commit access. So, whenever you think this change is good to go, feel free to push it.

@cseo The preferred approach is to request commit access: obtaining-commit-access

(Don't forget to update the test details!)

OK, will do. I updated the test to remove the hardcoded register.

flang/lib/Lower/Bridge.cpp

for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
       }
     }
   }
 
   void genFIR(const Fortran::parser::CaseConstruct &) {
     Fortran::lower::pft::Evaluation &eval = getEval();
     Fortran::lower::StatementContext stmtCtx;
     pushActiveConstruct(eval, stmtCtx);
-    for (Fortran::lower::pft::Evaluation &e : getEval().getNestedEvaluations())
+    for (Fortran::lower::pft::Evaluation &e : eval.getNestedEvaluations()) {
+      if (e.getIf<Fortran::parser::EndSelectStmt>())
+        maybeStartBlock(e.block);
+      else
         genFIR(e);
+    }
     popActiveConstruct();
   }
 
   template <typename A>
   void genNestedStatement(const Fortran::parser::Statement<A> &stmt) {
     setCurrentPosition(stmt.source);
     genFIR(stmt.statement);
   }
for (Fortran::lower::pft::Evaluation &eval :
             mlir::Value derived = builder->create<fir::ConvertOp>(
                 loc, classTy, fir::getBase(selector));
             addAssocEntitySymbol(selectorBox->clone(derived));
           }
         }
         builder->restoreInsertionPoint(crtInsPt);
         ++typeGuardIdx;
       } else if (eval.getIf<Fortran::parser::EndSelectStmt>()) {
-        genFIR(eval);
+        maybeStartBlock(eval.block);
         if (hasLocalScope)
           localSymbols.popScope();
       } else {
         genFIR(eval);
       }
     }
     popActiveConstruct();
   }
void genFIR(Fortran::lower::pft::Evaluation &eval,
     // 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;
     if (successor && blockIsUnterminated()) {
       if (successor->isIntermediateConstructStmt() &&
           successor->parentConstruct->lowerAsUnstructured())
         // Exit from an intermediate unstructured IF or SELECT construct block.
         genBranch(successor->parentConstruct->constructExit->block);
       else if (unstructuredContext && eval.isConstructStmt() &&
                successor == eval.controlSuccessor)
         // Exit from a degenerate, empty construct block.
         genBranch(eval.parentConstruct->constructExit->block);
     }
   }
 

flang/test/Lower/select-case-statement.f90

subroutine sforall(num)
     case default
       array = -1
     end select
     ! CHECK: cf.br ^bb3
     ! CHECK: ^bb3:  // 2 preds: ^bb1, ^bb2
     print*, array(1)
   end subroutine sforall
 
+  ! CHECK-LABEL: func @_QPsnested
+  subroutine snested(str)
+    character(*), optional :: str
+    integer :: num
+
+    if (present(str)) then
+      select case (trim(str))
+        case ('a')
+          num = 10
+        case default
+          num = 20
+      end select
+      ! CHECK: ^bb5:  // 2 preds: ^bb3, ^bb4
+      ! CHECK: fir.freemem %{{[0-9]+}} : !fir.heap<!fir.char<1,?>>
+      ! CHECK: cf.br ^bb7
+    else
+      num = 30
+    end if
+    ! CHECK: ^bb7:  // 2 preds: ^bb5, ^bb6
+  end subroutine snested
+
   ! CHECK-LABEL: main
   program p
     integer sinteger, v(10)
 
     n = -10
     do j = 1, 4
       do k = 1, 10
         n = n + 1