[Flang] Make a private copy for the common block variables in copyin clause

[Thirumalai-Shaktivel]

Fixes: #82949

[llvmbot]

@llvm/pr-subscribers-flang-fir-hlfir

@llvm/pr-subscribers-flang-openmp

Author: Thirumalai Shaktivel (Thirumalai-Shaktivel)

Changes

---

Full diff: https://github.com/llvm/llvm-project/pull/111359.diff

2 Files Affected:

• (modified) flang/lib/Lower/Bridge.cpp (+9-2)
• (modified) flang/test/Lower/OpenMP/copyin.f90 (+42)

diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 0894a5903635e1..58c2d0c2a209e1 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -921,13 +921,20 @@ class FirConverter : public Fortran::lower::AbstractConverter {
       std::function<void(const Fortran::semantics::Symbol &, bool)>
           insertSymbols = [&](const Fortran::semantics::Symbol &oriSymbol,
                               bool collectSymbol) {
-            if (collectSymbol && oriSymbol.test(flag))
+            if (collectSymbol && oriSymbol.test(flag)) {
               symbolSet.insert(&oriSymbol);
-            else if (checkHostAssociatedSymbols)
+            } else if (const auto *commonDetails =
+                           oriSymbol.detailsIf<
+                               Fortran::semantics::CommonBlockDetails>()) {
+              for (const auto &mem : commonDetails->objects())
+                if (collectSymbol && mem->test(flag))
+                  symbolSet.insert(&(*mem).GetUltimate());
+            } else if (checkHostAssociatedSymbols) {
               if (const auto *details{
                       oriSymbol
                           .detailsIf<Fortran::semantics::HostAssocDetails>()})
                 insertSymbols(details->symbol(), true);
+            }
           };
       insertSymbols(sym, collectSymbols);
     };
diff --git a/flang/test/Lower/OpenMP/copyin.f90 b/flang/test/Lower/OpenMP/copyin.f90
index b1c6b9420f4c46..6566158d71eddc 100644
--- a/flang/test/Lower/OpenMP/copyin.f90
+++ b/flang/test/Lower/OpenMP/copyin.f90
@@ -450,3 +450,45 @@ subroutine allocatable2()
     a = 1
   !$omp end parallel
 end subroutine
+
+! CHECK-LABEL:   func.func @_QPcommon_3() {
+! [...]
+! CHECK:           omp.parallel {
+! CHECK:             %[[VAL_22:.*]] = omp.threadprivate %[[VAL_0:.*]] : !fir.ref<!fir.array<32xi8>> -> !fir.ref<!fir.array<32xi8>>
+! CHECK:             %[[VAL_23:.*]] = fir.convert %[[VAL_22:.*]] : (!fir.ref<!fir.array<32xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:             %[[VAL_24:.*]] = arith.constant 0 : index
+! CHECK:             %[[VAL_25:.*]] = fir.coordinate_of %[[VAL_23:.*]], %[[VAL_24:.*]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:             %[[VAL_26:.*]] = fir.convert %[[VAL_25:.*]] : (!fir.ref<i8>) -> !fir.ref<i32>
+! CHECK:             %[[VAL_27:.*]]:2 = hlfir.declare %[[VAL_26:.*]] {uniq_name = "_QFcommon_3Ex"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:             %[[VAL_28:.*]] = fir.convert %[[VAL_22:.*]] : (!fir.ref<!fir.array<32xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:             %[[VAL_29:.*]] = arith.constant 4 : index
+! CHECK:             %[[VAL_30:.*]] = fir.coordinate_of %[[VAL_28:.*]], %[[VAL_29:.*]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:             %[[VAL_31:.*]] = fir.convert %[[VAL_30:.*]] : (!fir.ref<i8>) -> !fir.ref<i32>
+! CHECK:             %[[VAL_32:.*]]:2 = hlfir.declare %[[VAL_31:.*]] {uniq_name = "_QFcommon_3Ey"} : (!fir.ref<i32>) -> (!fir.ref<i32>, !fir.ref<i32>)
+! CHECK:             %[[VAL_33:.*]] = fir.convert %[[VAL_22:.*]] : (!fir.ref<!fir.array<32xi8>>) -> !fir.ref<!fir.array<?xi8>>
+! CHECK:             %[[VAL_34:.*]] = arith.constant 8 : index
+! CHECK:             %[[VAL_35:.*]] = fir.coordinate_of %[[VAL_33:.*]], %[[VAL_34:.*]] : (!fir.ref<!fir.array<?xi8>>, index) -> !fir.ref<i8>
+! CHECK:             %[[VAL_36:.*]] = fir.convert %[[VAL_35:.*]] : (!fir.ref<i8>) -> !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:             %[[VAL_37:.*]]:2 = hlfir.declare %[[VAL_36:.*]] {fortran_attrs = #fir.var_attrs<pointer>, uniq_name = "_QFcommon_3Earr"} : (!fir.ref<!fir.box<!fir.ptr<i32>>>) -> (!fir.ref<!fir.box<!fir.ptr<i32>>>, !fir.ref<!fir.box<!fir.ptr<i32>>>)
+! CHECK:             %[[VAL_38:.*]] = fir.load %[[VAL_16:.*]]#0 : !fir.ref<i32>
+! CHECK:             hlfir.assign %[[VAL_38:.*]] to %[[VAL_27:.*]]#0 : i32, !fir.ref<i32>
+! CHECK:             %[[VAL_39:.*]] = fir.load %[[VAL_21:.*]]#0 : !fir.ref<i32>
+! CHECK:             hlfir.assign %[[VAL_39:.*]] to %[[VAL_32:.*]]#0 : i32, !fir.ref<i32>
+! CHECK:             %[[VAL_40:.*]] = fir.load %[[VAL_11:.*]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:             fir.store %[[VAL_40:.*]] to %[[VAL_37:.*]]#0 : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:             omp.barrier
+! CHECK:             omp.terminator
+! CHECK:           }
+! CHECK:           return
+! CHECK:         }
+
+subroutine common_3()
+  integer :: x, y
+  integer, pointer :: arr
+  common /c3/ x, y, arr
+  !$omp threadprivate(/c3/)
+
+  !$omp parallel copyin(/c3/)
+     call sub_3()
+  !$omp end parallel
+end subroutine

[kiranchandramohan]

Would you have time to do something similar to the handling of the private clause? As in capture the copyin clause in dialect with a Private clause like op describing how to create the copy.

[Thirumalai-Shaktivel]

Yea, sure.

I have marked this PR as draft.

[kiranchandramohan]

@Thirumalai-Shaktivel Can you get this patch ready in the current form?

[Thirumalai-Shaktivel]

Yeah, sure, I will rebase this PR with the latest main.

Sorry, I didn't have time to come back to work on this.

[Thirumalai-Shaktivel]

Ready!
I have updated the branch.

I'm getting the following output:

$ ./a.out 
 sub  : b( 1 ) =  1.  a( 1 ) =  1.
 sub  : b( 2 ) =  3.  a( 2 ) =  2.
 OK

, for the following example:

program main
    integer err
    real,dimension(2):: a, b, c
    common /blk/ a, b
  !$omp threadprivate(/blk/)
    a = (/(i,i=1,2)/)
    b = (/(i*(i+1)/2,i=1,2)/)
    c = 0
  !$omp parallel do private(sum), copyin(/blk/)
    do i=1, 2
       sum = i
       call sub(sum, i, c(i))
    end do
  !$omp end parallel do
    err = 0
    do i=1, 2
       if(c(i) .ne. b(i)) err = err+1
    end do
    if(err .ne. 0) then
       write(6,*) "NG"
    else
       write(6,*) "OK"
    end if
  end program main

  subroutine sub(sum, i, c)
    real,dimension(2):: a, b
    common /blk/ a, b
    real c
  !$omp threadprivate(/blk/)
    c = b(i)-a(i)+sum
    write(6,*) "sub  : b(",i,") = ",b(i), " a(",i,") = ", a(i)
  end subroutine sub

[NimishMishra]

Thanks for the fix. LGTM.

We are essentially iterating over the common block details, and adding symbols of relevant flag to symbolSet, thereby marking them for privatization. I suggest we add a one-liner description of the fix to the PR.

Please wait for one more approval before merging.

[tblah]

This looks good to me, although my understanding of this patch is that it allows the common block variables to be processed by copyin, not by privatization.

[Thirumalai-Shaktivel]

It allows the common block variables to be processed by copyin, not by privatization.

Yes.