[Flang] Lower the FailImage Statement

[kiranchandramohan]

Summary

Lowering of FailImage statement generates a runtime call and the
unreachable operation. The unreachable operation cannot terminate
a structured operation like the IF operation, hence mark as
unstructured.

Note: This patch is part of upstreaming code from the fir-dev branch of
https://github.com/flang-compiler/f18-llvm-project.

Co-authored-by: Eric Schweitz <[e-mail]>

[clementval]

LGTM

flang/lib/Lower/Bridge.cpp

#endif
   }
 
   void genFIR(const Fortran::parser::PauseStmt &stmt) {
     genPauseStatement(*this, stmt);
   }
 
   // call FAIL IMAGE in runtime
   void genFIR(const Fortran::parser::FailImageStmt &stmt) {
-    TODO(toLocation(), "FailImageStmt lowering");
+    genFailImageStatement(*this);
   }
 
   // call STOP, ERROR STOP in runtime
   void genFIR(const Fortran::parser::StopStmt &stmt) {
     genStopStatement(*this, stmt);
   }
 
   void genFIR(const Fortran::parser::ReturnStmt &stmt) {

flang/lib/Lower/PFTBuilder.cpp

for (auto &eval : evaluationList) {
           [&](const parser::ExitStmt &s) {
             std::string name = getConstructName(s);
             lower::pft::Evaluation *construct{name.empty()
                                                   ? doConstructStack.back()
                                                   : constructNameMap[name]};
             assert(construct && "missing EXIT construct");
             markBranchTarget(eval, *construct->constructExit);
           },
+          [&](const parser::FailImageStmt &) {
+            eval.isUnstructured = true;
+            if (eval.lexicalSuccessor->lexicalSuccessor)
+              markSuccessorAsNewBlock(eval);
+          },
           [&](const parser::GotoStmt &s) { markBranchTarget(eval, s.v); },
           [&](const parser::IfStmt &) {
             eval.lexicalSuccessor->isNewBlock = true;
             lastConstructStmtEvaluation = &eval;
           },
           [&](const parser::ReturnStmt &) {
             eval.isUnstructured = true;
             if (eval.lexicalSuccessor->lexicalSuccessor)

flang/test/Lower/fail_image.f90

+! RUN: bbc -emit-fir -o - %s | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! CHECK-LABEL: func @_QPfail_image_test
+subroutine fail_image_test(fail)
+  logical :: fail
+! CHECK:  cond_br {{.*}}, ^[[BB1:.*]], ^[[BB2:.*]]
+! CHECK: ^[[BB1]]:
+  if (fail) then
+! CHECK:  {{.*}} = fir.call @_FortranAFailImageStatement() : () -> none
+! CHECK-NEXT:  fir.unreachable
+   FAIL IMAGE
+  end if
+! CHECK: ^[[BB2]]:
+! CHECK-NEXT:  br ^[[BB3:.*]]
+! CHECK-NEXT: ^[[BB3]]
+! CEHCK-NEXT:  return
+  return
+end subroutine
+! CHECK-LABEL: func private @_FortranAFailImageStatement() -> none attributes {fir.runtime}

flang/test/Lower/pre-fir-tree04.f90

if (this_image() == 1) then
     ! CHECK: SyncImagesStmt
     sync images(*)
   else
     ! CHECK: SyncImagesStmt
     sync images(1)
   end if
   ! CHECK: <<End IfConstruct>>
 
-  ! CHECK: <<IfConstruct>>
+  ! CHECK: <<IfConstruct!>>
   if (y<0.) then
     ! CHECK: FailImageStmt
    fail image
   end if
-  ! CHECK: <<End IfConstruct>>
+  ! CHECK: <<End IfConstruct!>>
 end