[flang][OpenMP][OpenACC] Fix exit of a region

[peixin]

Summary

The stop statement is allowed in OpenMP/OpenACC block region.

[peixin]

@kiranchandramohan left one comment here (https://reviews.llvm.org/D88655#2470610) more than one year ago, but there is no further update. Take up this.

I checked OpenACC 3.0, and there is no explicit description for the stop statement in a region. Then I checked gfortran, and this is OK for gfortran.

$ cat test.f90 
program m
  integer :: i, N=10, a(10)
  !$acc serial
  do i = 1, N
    a(i) = 3.14
    if(i == N-1) THEN
      stop 999 ! no error
    end if
  end do
  !$acc end serial
end
$ gfortran test.f90 -fopenacc
! no error

[shraiysh]

LGTM, thank you.

[kiranchandramohan]

LG. Is the generated code valid?

[peixin]

In D126471#3540359, @kiranchandramohan wrote:

LG. Is the generated code valid?

For semantic analysis, this patch is OK. Branching out of a OpenMP region has wrong semantics such as the slave thread GOTO the non-parallel region. For STOP statement, it aborts the program, which is expected.

For lowering, it hasn't handle this case. I will fix it later.

program m
  use omp_lib
  !$omp parallel num_threads(4)
    stop omp_get_thread_num()
  !$omp end parallel
end

$ bbc -emit-fir -fopenmp test.f90 && cat test.mlir
func.func @_QQmain() {
  %c4_i32 = arith.constant 4 : i32
  omp.parallel   num_threads(%c4_i32 : i32) {
    %0 = fir.call @omp_get_thread_num() : () -> i32
    %false = arith.constant false
    %false_0 = arith.constant false
    %1 = fir.call @_FortranAStopStatement(%0, %false, %false_0) : (i32, i1, i1) -> none
    fir.unreachable
  }
  return
}

Change it by-hand:

func.func @_QQmain() {
  %c4_i32 = arith.constant 4 : i32
  omp.parallel   num_threads(%c4_i32 : i32) {
    %0 = fir.call @omp_get_thread_num() : () -> i32
    %false = arith.constant false
    %false_0 = arith.constant false
    %1 = fir.call @_FortranAStopStatement(%0, %false, %false_0) : (i32, i1, i1) -> none
    omp.terminator
  }
  return
}

tco test.mlir -o test.ll
$ clang++ -L/path-to-lib -lFortran_main -lFortranRuntime -lFortranDecimal -lomp test.ll 
$ ./a.out 
Fortran STOP: code 1

Fortran STOP: code 3

IEEE arithmetic exceptions signaled: INEXACT
IEEE arithmetic exceptions signaled: INEXACT
Fortran STOP: code 2

IEEE arithmetic exceptions signaled: INEXACT
Fortran STOP

IEEE arithmetic exceptions signaled:

$ gfortran test.f90 -fopenmp && ./a.out
STOP 0
STOP 3
STOP 2

I will fix the lowering later.

[kiranchandramohan]

OK, LG.

[kiranchandramohan]

In D126471#3541535, @peixin wrote:

I will fix the lowering later.

Can you file a ticket so that we do not forget?

[peixin]

In D126471#3541902, @kiranchandramohan wrote:

In D126471#3541535, @peixin wrote:

I will fix the lowering later.

Can you file a ticket so that we do not forget?

Sure, will file the ticket before land this.

[peixin]

Create one issue: https://github.com/llvm/llvm-project/issues/55735

flang/lib/Semantics/check-directive-structure.h

public:
   void Post(const parser::ReturnStmt &) { EmitBranchOutError("RETURN"); }
   void Post(const parser::ExitStmt &exitStmt) {
     if (const auto &exitName{exitStmt.v}) {
       CheckConstructNameBranching("EXIT", exitName.value());
     } else {
       CheckConstructNameBranching("EXIT");
     }
   }
-  void Post(const parser::StopStmt &) { EmitBranchOutError("STOP"); }
   void Post(const parser::CycleStmt &cycleStmt) {
     if (const auto &cycleName{cycleStmt.v}) {
       CheckConstructNameBranching("CYCLE", cycleName.value());
     } else {
       switch ((llvm::omp::Directive)currentDirective_) {
       // exclude directives which do not need a check for unlabelled CYCLES
       case llvm::omp::Directive::OMPD_do:
       case llvm::omp::Directive::OMPD_simd:

flang/test/Semantics/OpenACC/acc-branch.f90

program openacc_clause_validity
   end do
   !$acc end parallel
 
   !$acc parallel
   !$acc loop
   do i = 1, N
     a(i) = 3.14
     if(i == N-1) THEN
-      !ERROR: STOP statement is not allowed in a PARALLEL construct
-      stop 999
+      stop 999 ! no error
     end if
   end do
   !$acc end parallel
 
   !$acc kernels
   do i = 1, N
     a(i) = 3.14
     !ERROR: RETURN statement is not allowed in a KERNELS construct
do i = 1, N
     end if
   end do
   !$acc end kernels
 
   !$acc kernels
   do i = 1, N
     a(i) = 3.14
     if(i == N-1) THEN
-      !ERROR: STOP statement is not allowed in a KERNELS construct
-      stop 999
+      stop 999 ! no error
     end if
   end do
   !$acc end kernels
 
   !$acc serial
   do i = 1, N
     a(i) = 3.14
     !ERROR: RETURN statement is not allowed in a SERIAL construct
do i = 1, N
     end do
   !$acc end serial
   end do name2
 
   !$acc serial
   do i = 1, N
     a(i) = 3.14
     if(i == N-1) THEN
-      !ERROR: STOP statement is not allowed in a SERIAL construct
-      stop 999
+      stop 999 ! no error
     end if
   end do
   !$acc end serial
 
 end program openacc_clause_validity

flang/test/Semantics/omp-parallel02.f90

program omp_parallel
   !CHECK: invalid branch into an OpenMP structured block
   goto 10
 
   !$omp parallel
   do i = 1, 10
     do j = 1, 10
       print *, "Hello"
       !CHECK: In the enclosing PARALLEL directive branched into
-      !CHECK: STOP statement is not allowed in a PARALLEL construct
       10 stop
     end do
   end do
   !$omp end parallel
 
 end program omp_parallel

flang/test/Semantics/omp-task01.f90

recursive subroutine traverse ( P )
 
   !CHECK: invalid branch into an OpenMP structured block
   goto 10
 
   if (associated(P%left)) then
     !$omp task
     call traverse(P%left)
     !CHECK: In the enclosing TASK directive branched into
-    !CHECK: STOP statement is not allowed in a TASK construct
     10 stop
     !$omp end task
   endif
 
   if (associated(P%right)) then
     !$omp task
     call traverse(P%right)
     !$omp end task
     endif
   call process ( P )
 
  end subroutine traverse