From acd75440c67acc31d9a5b0afdd64b5700be8960e Mon Sep 17 00:00:00 2001
From: Kiran Chandramohan <kiran.chandramohan@arm.com>
Date: Wed, 27 Apr 2022 12:19:54 +0000
Subject: [PATCH] [Flang] Lower the FailImage Statement

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.

Reviewed By: clementval

Differential Revision: https://reviews.llvm.org/D124520

Co-authored-by: Eric Schweitz <eschweitz@nvidia.com>
---
 flang/lib/Lower/Bridge.cpp          |  2 +-
 flang/lib/Lower/PFTBuilder.cpp      |  5 +++++
 flang/test/Lower/fail_image.f90     | 20 ++++++++++++++++++++
 flang/test/Lower/pre-fir-tree04.f90 |  4 ++--
 4 files changed, 28 insertions(+), 3 deletions(-)
 create mode 100644 flang/test/Lower/fail_image.f90

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 675f9c9..df89b8c 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -2013,7 +2013,7 @@ private:
 
   // call FAIL IMAGE in runtime
   void genFIR(const Fortran::parser::FailImageStmt &stmt) {
-    TODO(toLocation(), "FailImageStmt lowering");
+    genFailImageStatement(*this);
   }
 
   // call STOP, ERROR STOP in runtime
diff --git a/flang/lib/Lower/PFTBuilder.cpp b/flang/lib/Lower/PFTBuilder.cpp
index 4d80ff5..478ca19 100644
--- a/flang/lib/Lower/PFTBuilder.cpp
+++ b/flang/lib/Lower/PFTBuilder.cpp
@@ -744,6 +744,11 @@ private:
             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;
diff --git a/flang/test/Lower/fail_image.f90 b/flang/test/Lower/fail_image.f90
new file mode 100644
index 0000000..9da162f
--- /dev/null
+++ b/flang/test/Lower/fail_image.f90
@@ -0,0 +1,20 @@
+! 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}
diff --git a/flang/test/Lower/pre-fir-tree04.f90 b/flang/test/Lower/pre-fir-tree04.f90
index a04bf14..8188bfd 100644
--- a/flang/test/Lower/pre-fir-tree04.f90
+++ b/flang/test/Lower/pre-fir-tree04.f90
@@ -61,10 +61,10 @@ Subroutine test_coarray
   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
-- 
2.7.4