diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp --- a/flang/lib/Lower/Bridge.cpp +++ b/flang/lib/Lower/Bridge.cpp @@ -2013,7 +2013,7 @@ // 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 --- a/flang/lib/Lower/PFTBuilder.cpp +++ b/flang/lib/Lower/PFTBuilder.cpp @@ -744,6 +744,11 @@ 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 --- /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 --- a/flang/test/Lower/pre-fir-tree04.f90 +++ b/flang/test/Lower/pre-fir-tree04.f90 @@ -61,10 +61,10 @@ end if ! CHECK: <> - ! CHECK: <> + ! CHECK: <> if (y<0.) then ! CHECK: FailImageStmt fail image end if - ! CHECK: <> + ! CHECK: <> end