[flang-commits] [flang] [flang][hlfir] patch for assumed shape dummy with VALUE keyword when lowering to HLFIR (PR #70391)

Anthony Cabrera via flang-commits flang-commits at lists.llvm.org
Tue Nov 7 10:10:15 PST 2023


https://github.com/cabreraam updated https://github.com/llvm/llvm-project/pull/70391

>From 27a5100590d069e0588b76dd54b463ad9f64b8f7 Mon Sep 17 00:00:00 2001
From: cabreraam <cabreraam33 at gmail.com>
Date: Thu, 26 Oct 2023 21:37:28 -0400
Subject: [PATCH 1/3] [flang][hlfir] patch for assumed shape dummy with VALUE
 keyword

---
 flang/lib/Lower/CallInterface.cpp             |  12 +-
 .../assumed_shape_with_value_keyword.f90      | 149 ++++++++++++++++++
 2 files changed, 157 insertions(+), 4 deletions(-)
 create mode 100644 flang/test/HLFIR/assumed_shape_with_value_keyword.f90

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index 43bbbb933658a8a..d7e40cd23a6fa46 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1002,10 +1002,14 @@ class Fortran::lower::CallInterfaceImpl {
       addPassedArg(PassEntityBy::MutableBox, entity, characteristics);
     } else if (dummyRequiresBox(obj, isBindC)) {
       // Pass as fir.box or fir.class
-      if (isValueAttr)
-        TODO(loc, "assumed shape dummy argument with VALUE attribute");
-      addFirOperand(boxType, nextPassedArgPosition(), Property::Box, attrs);
-      addPassedArg(PassEntityBy::Box, entity, characteristics);
+      Property prop = Property::Box;
+      PassEntityBy passBy = PassEntityBy::Box;
+      if (isValueAttr) {
+        passBy = PassEntityBy::BaseAddressValueAttribute;
+        prop = Property::Value;
+      }
+      addFirOperand(boxType, nextPassedArgPosition(), prop, attrs);
+      addPassedArg(passBy, entity, characteristics);
     } else if (dynamicType.category() ==
                Fortran::common::TypeCategory::Character) {
       // Pass as fir.box_char
diff --git a/flang/test/HLFIR/assumed_shape_with_value_keyword.f90 b/flang/test/HLFIR/assumed_shape_with_value_keyword.f90
new file mode 100644
index 000000000000000..b5080d9bedca690
--- /dev/null
+++ b/flang/test/HLFIR/assumed_shape_with_value_keyword.f90
@@ -0,0 +1,149 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+
+! Addresses assumed shape dummy argument with VALUE keyword
+
+subroutine test_integer_value1(x)
+  integer, value :: x(:)
+  call internal_call1(x)
+end
+
+! CHECK-LABEL:  func.func @_QPtest_integer_value1(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xi32>> {fir.bindc_name = "x"}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_integer_value1Ex"} : (!fir.box<!fir.array<?xi32>>) -> (!fir.box<!fir.array<?xi32>>, !fir.box<!fir.array<?xi32>>)
+! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?xi32>>) -> (!fir.box<!fir.array<?xi32>>, i1)
+! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK:          fir.call @_QPinternal_call1(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xi32>>) -> ()
+! CHECK:          hlfir.copy_out %[[VAL_1]]#0, %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?xi32>>, i1, !fir.box<!fir.array<?xi32>>) -> ()
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_integer_value2(x)
+  integer, value :: x(:,:)
+  call internal_call2(x)
+end
+! CHECK-LABEL:  func.func @_QPtest_integer_value2(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xi32>> {fir.bindc_name = "x"}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_integer_value2Ex"} : (!fir.box<!fir.array<?x?xi32>>) -> (!fir.box<!fir.array<?x?xi32>>, !fir.box<!fir.array<?x?xi32>>)
+! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?xi32>>) -> (!fir.box<!fir.array<?x?xi32>>, i1)
+! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?xi32>>) -> !fir.ref<!fir.array<?x?xi32>>
+! CHECK:          fir.call @_QPinternal_call2(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xi32>>) -> ()
+! CHECK:          hlfir.copy_out %[[VAL_1]]#0, %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?xi32>>, i1, !fir.box<!fir.array<?x?xi32>>) -> ()
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_real_value1(x) 
+  real, value :: x(:)
+  call internal_call3(x)
+end
+! CHECK-LABEL:  func.func @_QPtest_real_value1(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x"}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_real_value1Ex"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, i1)
+! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK:          fir.call @_QPinternal_call3(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?xf32>>) -> ()
+! CHECK:          hlfir.copy_out %[[VAL_1]]#0, %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_real_value2(x) 
+  real, value :: x(:,:)
+  call internal_call4(x)
+end
+! CHECK-LABEL:  func.func @_QPtest_real_value2(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x"}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_real_value2Ex"} : (!fir.box<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, i1)
+! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
+! CHECK:          fir.call @_QPinternal_call4(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xf32>>) -> ()
+! CHECK:          hlfir.copy_out %[[VAL_1]]#0, %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?xf32>>, i1, !fir.box<!fir.array<?x?xf32>>) -> ()
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_complex_value1(x)
+  complex, value :: x(:)
+  call internal_call5(x)
+end
+! CHECK-LABEL:  func.func @_QPtest_complex_value1(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x!fir.complex<4>>> {fir.bindc_name = "x"}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_complex_value1Ex"} : (!fir.box<!fir.array<?x!fir.complex<4>>>) -> (!fir.box<!fir.array<?x!fir.complex<4>>>, !fir.box<!fir.array<?x!fir.complex<4>>>)
+! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?x!fir.complex<4>>>) -> (!fir.box<!fir.array<?x!fir.complex<4>>>, i1)
+! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x!fir.complex<4>>>) -> !fir.ref<!fir.array<?x!fir.complex<4>>>
+! CHECK:          fir.call @_QPinternal_call5(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x!fir.complex<4>>>) -> ()
+! CHECK:          hlfir.copy_out %[[VAL_1]]#0, %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?x!fir.complex<4>>>, i1, !fir.box<!fir.array<?x!fir.complex<4>>>) -> ()
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_complex_value2(x)
+  complex, value :: x(:,:)
+  call internal_call6(x)
+end
+! CHECK-LABEL:  func.func @_QPtest_complex_value2(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?x!fir.complex<4>>> {fir.bindc_name = "x"}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<value>, uniq_name = "_QFtest_complex_value2Ex"} : (!fir.box<!fir.array<?x?x!fir.complex<4>>>) -> (!fir.box<!fir.array<?x?x!fir.complex<4>>>, !fir.box<!fir.array<?x?x!fir.complex<4>>>)
+! CHECK:          %[[VAL_1:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?x!fir.complex<4>>>) -> (!fir.box<!fir.array<?x?x!fir.complex<4>>>, i1)
+! CHECK:          %[[VAL_2:.*]] = fir.box_addr %[[VAL_1]]#0 : (!fir.box<!fir.array<?x?x!fir.complex<4>>>) -> !fir.ref<!fir.array<?x?x!fir.complex<4>>>
+! CHECK:          fir.call @_QPinternal_call6(%[[VAL_2]]) fastmath<contract> : (!fir.ref<!fir.array<?x?x!fir.complex<4>>>) -> ()
+! CHECK:          hlfir.copy_out %[[VAL_1]]#0, %[[VAL_1]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?x!fir.complex<4>>>, i1, !fir.box<!fir.array<?x?x!fir.complex<4>>>) -> ()
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_optional1(x)
+  real, value, optional :: x(:)
+  if (present(x)) then
+    call internal_call7(x)
+  endif
+end
+! CHECK-LABEL:  func.func @_QPtest_optional1(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<optional, value>, uniq_name = "_QFtest_optional1Ex"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:          %[[VAL_1:.*]] = fir.is_present %[[VAL_0]]#1 : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK:          fir.if %[[VAL_1:.*]] {
+! CHECK:            %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, i1)
+! CHECK:            %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?xf32>>) -> !fir.ref<!fir.array<?xf32>>
+! CHECK:            fir.call @_QPinternal_call7(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?xf32>>) -> ()
+! CHECK:            hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?xf32>>, i1, !fir.box<!fir.array<?xf32>>) -> ()
+! CHECK:          } else {
+! CHECK:          }
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_optional2(x)
+  real, value, optional :: x(:,:)
+  if (present(x)) then
+    call internal_call8(x)
+  endif
+end
+! CHECK-LABEL:  func.func @_QPtest_optional2(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?x?xf32>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<optional, value>, uniq_name = "_QFtest_optional2Ex"} : (!fir.box<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, !fir.box<!fir.array<?x?xf32>>)
+! CHECK:          %[[VAL_1:.*]] = fir.is_present %[[VAL_0]]#1 : (!fir.box<!fir.array<?x?xf32>>) -> i1
+! CHECK:          fir.if %[[VAL_1:.*]] {
+! CHECK:            %[[VAL_2:.*]]:2 = hlfir.copy_in %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?xf32>>) -> (!fir.box<!fir.array<?x?xf32>>, i1)
+! CHECK:            %[[VAL_3:.*]] = fir.box_addr %[[VAL_2]]#0 : (!fir.box<!fir.array<?x?xf32>>) -> !fir.ref<!fir.array<?x?xf32>>
+! CHECK:            fir.call @_QPinternal_call8(%[[VAL_3]]) fastmath<contract> : (!fir.ref<!fir.array<?x?xf32>>) -> ()
+! CHECK:            hlfir.copy_out %[[VAL_2]]#0, %[[VAL_2]]#1 to %[[VAL_0]]#0 : (!fir.box<!fir.array<?x?xf32>>, i1, !fir.box<!fir.array<?x?xf32>>) -> ()
+! CHECK:          } else {
+! CHECK:          }
+! CHECK:          return
+! CHECK:        }
+
+subroutine test_optional3(x)
+  real, value, optional :: x(:)
+  if (present(x)) then
+    stop
+  endif
+end
+! CHECK-LABEL:  func.func @_QPtest_optional3(
+! CHECK-SAME:     %[[ARG0:.*]]: !fir.box<!fir.array<?xf32>> {fir.bindc_name = "x", fir.optional}) {
+! CHECK:          %[[VAL_0:.*]]:2 = hlfir.declare %[[ARG0]] {fortran_attrs = #fir.var_attrs<optional, value>, uniq_name = "_QFtest_optional3Ex"} : (!fir.box<!fir.array<?xf32>>) -> (!fir.box<!fir.array<?xf32>>, !fir.box<!fir.array<?xf32>>)
+! CHECK:          %[[VAL_1:.*]] = fir.is_present %[[VAL_0]]#1 : (!fir.box<!fir.array<?xf32>>) -> i1
+! CHECK:          cf.cond_br %[[VAL_1]], ^bb1, ^bb2
+! CHECK:          b1:  // pred: ^bb0
+! CHECK:          %[[C0_I32:.*]] = arith.constant 0 : i32
+! CHECK:          %[[FALSE:.*]] = arith.constant false
+! CHECK:          %[[FALSE_0:.*]] = arith.constant false
+! CHECK:          %[[VAL_2:.*]] = fir.call @_FortranAStopStatement(%[[C0_I32]], %[[FALSE]], %[[FALSE]]_0) fastmath<contract> : (i32, i1, i1) -> none
+! CHECK:          fir.unreachable
+! CHECK:          b2:  // pred: ^bb0
+! CHECK:          return
+! CHECK:        }
\ No newline at end of file

>From 7c4a4f43fae4d432ea1a44dad5f40fb290d172e5 Mon Sep 17 00:00:00 2001
From: cabreraam <cabreraam33 at gmail.com>
Date: Tue, 31 Oct 2023 14:38:45 -0400
Subject: [PATCH 2/3] address Jean's comments about argument handling in
 CallInterface

---
 flang/lib/Lower/CallInterface.cpp | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index d7e40cd23a6fa46..f4e3dd34808e460 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1002,12 +1002,15 @@ class Fortran::lower::CallInterfaceImpl {
       addPassedArg(PassEntityBy::MutableBox, entity, characteristics);
     } else if (dummyRequiresBox(obj, isBindC)) {
       // Pass as fir.box or fir.class
+      if (isValueAttr &&
+          !getConverter().getLoweringOptions().getLowerToHighLevelFIR())
+        TODO(loc, "assumed shape dummy argument with VALUE attribute");
       Property prop = Property::Box;
       PassEntityBy passBy = PassEntityBy::Box;
-      if (isValueAttr) {
+      /*if (isValueAttr) {
         passBy = PassEntityBy::BaseAddressValueAttribute;
         prop = Property::Value;
-      }
+      }*/
       addFirOperand(boxType, nextPassedArgPosition(), prop, attrs);
       addPassedArg(passBy, entity, characteristics);
     } else if (dynamicType.category() ==

>From 74ba36998b822a1fdfc8786433256d487b435b86 Mon Sep 17 00:00:00 2001
From: cabreraam <cabreraam33 at gmail.com>
Date: Tue, 7 Nov 2023 13:09:13 -0500
Subject: [PATCH 3/3] address nits

---
 flang/lib/Lower/CallInterface.cpp | 10 ++--------
 1 file changed, 2 insertions(+), 8 deletions(-)

diff --git a/flang/lib/Lower/CallInterface.cpp b/flang/lib/Lower/CallInterface.cpp
index f4e3dd34808e460..4df203e6d31e276 100644
--- a/flang/lib/Lower/CallInterface.cpp
+++ b/flang/lib/Lower/CallInterface.cpp
@@ -1005,14 +1005,8 @@ class Fortran::lower::CallInterfaceImpl {
       if (isValueAttr &&
           !getConverter().getLoweringOptions().getLowerToHighLevelFIR())
         TODO(loc, "assumed shape dummy argument with VALUE attribute");
-      Property prop = Property::Box;
-      PassEntityBy passBy = PassEntityBy::Box;
-      /*if (isValueAttr) {
-        passBy = PassEntityBy::BaseAddressValueAttribute;
-        prop = Property::Value;
-      }*/
-      addFirOperand(boxType, nextPassedArgPosition(), prop, attrs);
-      addPassedArg(passBy, entity, characteristics);
+      addFirOperand(boxType, nextPassedArgPosition(), Property::Box, attrs);
+      addPassedArg(PassEntityBy::Box, entity, characteristics);
     } else if (dynamicType.category() ==
                Fortran::common::TypeCategory::Character) {
       // Pass as fir.box_char



More information about the flang-commits mailing list