[flang] Fix one bug in nested branching-related constructs

[peixin]

Summary

When setting construct exit in creating PFT, it does not consider if
there is one compile-time generated statement such as memory free in the
successor. So, using nonNopSuccessor in setConstructExit is not
correct when the select case construct is perfectly nested in the if
construct and there is one temporary memory generated in the select case
construct which needs memory free when ending the select case construct.
This bug is exposed in cam4 in SPEC2017
https://github.com/llvm/llvm-project/issues/56143.

[peixin]

@jeanPerier @schweitz This is the initial try to fix the bug. I guess https://github.com/llvm/llvm-project/issues/56143 exposes one class of bugs. Fixing it considering all kinds of nested constructs is kind of difficult for me for now. If this is not the right fix, please feel free to take up this.

[kiranchandramohan]

Thanks @peixin for investigating this and proposing a fix.

I spent some time on this. Something that came to my mind is that ideally, it is best to have the blocks belonging to the CaseConstruct itself deal with the deallocation. So how about something like adding a block to EndSelect and then marking that as the constructExit for the CaseConstruct? Something like the following.

Otherwise, we might need to have pre-fir-tree test as well.

diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 49ae53118473..ee7a193ef59d 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -831,6 +831,7 @@ private:
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::EndSelectStmt &) {
+            eval.isNewBlock = true;
             eval.nonNopSuccessor().isNewBlock = true; 
             lastConstructStmtEvaluation = nullptr;
           },
@@ -927,7 +928,8 @@ private:
             eval.constructExit = &eval.evaluationList->back();
           },
           [&](const parser::CaseConstruct &) {
-            setConstructExit(eval);
+            // EndSelectCaseStmt may have code.
+            eval.constructExit = &eval.evaluationList->back();
             eval.isUnstructured = true;
           },
           [&](const parser::ChangeTeamConstruct &) {

[peixin]

In D128349#3611796, @kiranchandramohan wrote:

Thanks @peixin for investigating this and proposing a fix.

I spent some time on this. Something that came to my mind is that ideally, it is best to have the blocks belonging to the CaseConstruct itself deal with the deallocation. So how about something like adding a block to EndSelect and then marking that as the constructExit for the CaseConstruct? Something like the following.

Otherwise, we might need to have pre-fir-tree test as well.

diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 49ae53118473..ee7a193ef59d 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -831,6 +831,7 @@ private:
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::EndSelectStmt &) {
+            eval.isNewBlock = true;
             eval.nonNopSuccessor().isNewBlock = true; 
             lastConstructStmtEvaluation = nullptr;
           },
@@ -927,7 +928,8 @@ private:
             eval.constructExit = &eval.evaluationList->back();
           },
           [&](const parser::CaseConstruct &) {
-            setConstructExit(eval);
+            // EndSelectCaseStmt may have code.
+            eval.constructExit = &eval.evaluationList->back();
             eval.isUnstructured = true;
           },
           [&](const parser::ChangeTeamConstruct &) {

@kiranchandramohan This sounds one more resonable PFT to me. Are you trying this? Will this change in creating PFT affect the FIR lowering? That is, does FIR lowering also need to change something so to solve the bug you found?

Maybe trying this with some test cases is better for reviewers?

[kiranchandramohan]

I dont think any change in lowering is required.
Yes, you are right that it will be good to test it well. I can try it later this week.

flang/test/Lower/nested-branching.f90

1

Nit: Add the flang-new driver also.

[vdonaldson]

@peixin, thanks for investigating this problem. Unfortunately, because CASE code can contain arbitrary GOTOs, there is no guarantee that a construct successor or exit block will be executed. The problem can be addressed by freeing the selector temp after the places in the code where it is last used. I'm working on a fix that does that.

[peixin]

In D128349#3615963, @vdonaldson wrote:

@peixin, thanks for investigating this problem. Unfortunately, because CASE code can contain arbitrary GOTOs, there is no guarantee that a construct successor or exit block will be executed. The problem can be addressed by freeing the selector temp after the places in the code where it is last used. I'm working on a fix that does that.

OK. Thanks for working on that.

flang/lib/Lower/Bridge.cpp

if (isCharSelector) {
       if (isLogicalSelector)
         selector = builder->createConvert(loc, builder->getI1Type(), selector);
     }
     mlir::Type selectType = selector.getType();
     llvm::SmallVector<mlir::Attribute> attrList;
     llvm::SmallVector<mlir::Value> valueList;
     llvm::SmallVector<mlir::Block *> blockList;
     mlir::Block *defaultBlock = eval.parentConstruct->constructExit->block;
+    if (!defaultBlock &&
+        eval.parentConstruct->constructExit->lexicalSuccessor->block) {
+      // The CaseConstruct is perfectly nested in other construct without any
+      // other statements. The exit block is the block of the sucessor of parent
+      // construct exit.
+      defaultBlock =
+          eval.parentConstruct->constructExit->lexicalSuccessor->block;
+    }
     using CaseValue = Fortran::parser::Scalar<Fortran::parser::ConstantExpr>;
     auto addValue = [&](const CaseValue &caseValue) {
       const Fortran::lower::SomeExpr *expr =
           Fortran::semantics::GetExpr(caseValue.thing);
       if (isCharSelector)
         valueList.push_back(charValue(expr));
       else if (isLogicalSelector)
         valueList.push_back(builder->createConvert(

flang/lib/Lower/PFTBuilder.cpp

for (auto &eval : evaluationList) {
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::CaseStmt &) {
             eval.isNewBlock = true;
             lastConstructStmtEvaluation->controlSuccessor = &eval;
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::EndSelectStmt &) {
-            eval.nonNopSuccessor().isNewBlock = true;
+            eval.lexicalSuccessor->isNewBlock = true;
             lastConstructStmtEvaluation = nullptr;
           },
           [&](const parser::ChangeTeamStmt &s) {
             insertConstructName(s, parentConstruct);
           },
           [&](const parser::CriticalStmt &s) {
             insertConstructName(s, parentConstruct);
           },
for (auto &eval : evaluationList) {
 
           // Constructs - set (unstructured) construct exit targets
           [&](const parser::AssociateConstruct &) { setConstructExit(eval); },
           [&](const parser::BlockConstruct &) {
             // EndBlockStmt may have code.
             eval.constructExit = &eval.evaluationList->back();
           },
           [&](const parser::CaseConstruct &) {
-            setConstructExit(eval);
+            // FIXME: Fix this by using one general solution by fixing
+            // `setConstructExit` considering there is nop successor when
+            // creating PFT, but generating one statement such as memory free
+            // when lowering.
+            eval.constructExit = eval.evaluationList->back().lexicalSuccessor;
             eval.isUnstructured = true;
           },
           [&](const parser::ChangeTeamConstruct &) {
             // EndChangeTeamStmt may have code.
             eval.constructExit = &eval.evaluationList->back();
           },
           [&](const parser::CriticalConstruct &) {
             // EndCriticalStmt may have code.

flang/test/Lower/nested-branching.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+
+! CHECK-LABEL: func.func @_QMmPhd() {
+! CHECK:  %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.heap<!fir.char<1,?>>>
+! CHECK:  cf.cond_br %{{.*}}, ^bb1, ^bb4
+! CHECK:^bb1:  // pred: ^bb0
+! CHECK:  %[[VAL_1:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.heap<!fir.char<1,?>>>>
+! CHECK:  %[[VAL_2:.*]] = fir.box_elesize %[[VAL_1]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> index
+! CHECK:  %[[VAL_3:.*]] = fir.box_addr %[[VAL_2:.*]] : (!fir.box<!fir.heap<!fir.char<1,?>>>) -> !fir.heap<!fir.char<1,?>>
+! CHECK:  cf.cond_br %{{.*}}, ^bb2, ^bb2
+! CHECK:^bb2:  // 2 preds: ^bb1, ^bb1
+! CHECK:  cf.br ^bb3
+! CHECK:^bb3:  // pred: ^bb2
+! CHECK:  fir.freemem %[[VAL_3]] : !fir.heap<!fir.char<1,?>>
+! CHECK:  cf.br ^bb4
+! CHECK:^bb4:  // 2 preds: ^bb0, ^bb3
+! CHECK:  return
+! CHECK:}
+
+module m
+  character(len=16) :: x
+contains
+  subroutine hd
+    if (.true.) then
+       select case(trim(x))
+       case('abc')
+          continue
+       end select
+    end if
+  end subroutine
+end module m