[flang] Accept assumed shape arrays as SHAPE in C_F_POINTER

[jeanPerier]

Summary

C_F_POINTER was added in https://reviews.llvm.org/D132303, but the code
assumed that SHAPE would always be an explicit shape with compile time
constant rank. It can actually be an assumed shape, or an explicit shape
with non compile time constant rank. Get the rank from FPTR pointer
instead.

[peixin]

Thanks. LGTM.

[clementval]

LGTM

flang/lib/Lower/IntrinsicCall.cpp

void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
   auto getCPtrExtVal = [&](fir::MutableBoxValue box) -> fir::ExtendedValue {
     mlir::Value addr =
         builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);
     mlir::SmallVector<mlir::Value> extents;
     if (box.hasRank()) {
       assert(isStaticallyPresent(args[2]) &&
              "FPTR argument must be an array if SHAPE argument exists");
       mlir::Value shape = fir::getBase(args[2]);
-      mlir::Type shapeArrTy = fir::unwrapRefType(shape.getType());
-      auto arrayRank = shapeArrTy.cast<fir::SequenceType>().getShape()[0];
-      assert(arrayRank > 0 && arrayRank <= 15 &&
-             "The rank of array must have been known and in range 1-15");
-      for (int i = 0; i < (int)arrayRank; ++i) {
-        mlir::Value index =
-            builder.createIntegerConstant(loc, builder.getIntegerType(32), i);
+      int arrayRank = box.rank();
+      mlir::Type shapeElementType =
+          fir::unwrapSequenceType(fir::unwrapPassByRefType(shape.getType()));
+      mlir::Type idxType = builder.getIndexType();
+      for (int i = 0; i < arrayRank; ++i) {
+        mlir::Value index = builder.createIntegerConstant(loc, idxType, i);
         mlir::Value var = builder.create<fir::CoordinateOp>(
-            loc, builder.getRefType(fir::unwrapSequenceType(shapeArrTy)), shape,
-            index);
+            loc, builder.getRefType(shapeElementType), shape, index);
         mlir::Value load = builder.create<fir::LoadOp>(loc, var);
-        extents.push_back(
-            builder.createConvert(loc, builder.getIndexType(), load));
+        extents.push_back(builder.createConvert(loc, idxType, load));
       }
     }
     if (box.isCharacter()) {
       mlir::Value len = box.nonDeferredLenParams()[0];
       if (box.hasRank())
         return fir::CharArrayBoxValue{addr, len, extents};
       return fir::CharBoxValue{addr, len};
     }

flang/test/Lower/Intrinsics/c_f_pointer.f90

 
 ! CHECK-LABEL: func.func @_QPtest_array(
 ! CHECK-SAME:                           %[[VAL_0:.*]]: !fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>> {fir.bindc_name = "cptr"},
 ! CHECK-SAME:                           %[[VAL_1:.*]]: !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>> {fir.bindc_name = "fptr"}) {
 ! CHECK:         %[[VAL_65:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
 ! CHECK:         %[[VAL_66:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_65]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
 ! CHECK:         %[[VAL_67:.*]] = fir.load %[[VAL_66]] : !fir.ref<i64>
 ! CHECK:         %[[VAL_68:.*]] = fir.convert %[[VAL_67]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>
-! CHECK:         %[[VAL_69:.*]] = arith.constant 0 : i32
-! CHECK:         %[[VAL_70:.*]] = fir.coordinate_of %[[VAL_53:.*]], %[[VAL_69]] : (!fir.heap<!fir.array<2xi32>>, i32) -> !fir.ref<i32>
+! CHECK:         %[[VAL_69:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_70:.*]] = fir.coordinate_of %[[VAL_53:.*]], %[[VAL_69]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>
 ! CHECK:         %[[VAL_71:.*]] = fir.load %[[VAL_70]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_72:.*]] = fir.convert %[[VAL_71]] : (i32) -> index
-! CHECK:         %[[VAL_73:.*]] = arith.constant 1 : i32
-! CHECK:         %[[VAL_74:.*]] = fir.coordinate_of %[[VAL_53]], %[[VAL_73]] : (!fir.heap<!fir.array<2xi32>>, i32) -> !fir.ref<i32>
+! CHECK:         %[[VAL_73:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_74:.*]] = fir.coordinate_of %[[VAL_53]], %[[VAL_73]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>
 ! CHECK:         %[[VAL_75:.*]] = fir.load %[[VAL_74]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_76:.*]] = fir.convert %[[VAL_75]] : (i32) -> index
 ! CHECK:         %[[VAL_77:.*]] = fir.shape %[[VAL_72]], %[[VAL_76]] : (index, index) -> !fir.shape<2>
 ! CHECK:         %[[VAL_78:.*]] = fir.embox %[[VAL_68]](%[[VAL_77]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
 ! CHECK:         fir.store %[[VAL_78]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
 ! CHECK:         return
 ! CHECK:       }
 

 ! CHECK:         %[[VAL_7:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_8:.*]] = arith.constant 0 : i32
 ! CHECK:         %[[VAL_9:.*]] = arith.cmpi sgt, %[[VAL_7]], %[[VAL_8]] : i32
 ! CHECK:         %[[VAL_10:.*]] = arith.select %[[VAL_9]], %[[VAL_7]], %[[VAL_8]] : i32
 ! CHECK:         %[[VAL_70:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
 ! CHECK:         %[[VAL_71:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_70]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
 ! CHECK:         %[[VAL_72:.*]] = fir.load %[[VAL_71]] : !fir.ref<i64>
 ! CHECK:         %[[VAL_73:.*]] = fir.convert %[[VAL_72]] : (i64) -> !fir.ptr<!fir.array<?x?x!fir.char<1,?>>>
-! CHECK:         %[[VAL_74:.*]] = arith.constant 0 : i32
-! CHECK:         %[[VAL_75:.*]] = fir.coordinate_of %[[VAL_58:.*]], %[[VAL_74]] : (!fir.heap<!fir.array<2xi32>>, i32) -> !fir.ref<i32>
+! CHECK:         %[[VAL_74:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_75:.*]] = fir.coordinate_of %[[VAL_58:.*]], %[[VAL_74]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>
 ! CHECK:         %[[VAL_76:.*]] = fir.load %[[VAL_75]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_77:.*]] = fir.convert %[[VAL_76]] : (i32) -> index
-! CHECK:         %[[VAL_78:.*]] = arith.constant 1 : i32
-! CHECK:         %[[VAL_79:.*]] = fir.coordinate_of %[[VAL_58]], %[[VAL_78]] : (!fir.heap<!fir.array<2xi32>>, i32) -> !fir.ref<i32>
+! CHECK:         %[[VAL_78:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_79:.*]] = fir.coordinate_of %[[VAL_58]], %[[VAL_78]] : (!fir.heap<!fir.array<2xi32>>, index) -> !fir.ref<i32>
 ! CHECK:         %[[VAL_80:.*]] = fir.load %[[VAL_79]] : !fir.ref<i32>
 ! CHECK:         %[[VAL_81:.*]] = fir.convert %[[VAL_80]] : (i32) -> index
 ! CHECK:         %[[VAL_82:.*]] = fir.shape %[[VAL_77]], %[[VAL_81]] : (index, index) -> !fir.shape<2>
 ! CHECK:         %[[VAL_83:.*]] = fir.embox %[[VAL_73]](%[[VAL_82]]) typeparams %[[VAL_10]] : (!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>, !fir.shape<2>, i32) -> !fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>
 ! CHECK:         fir.store %[[VAL_83]] to %[[VAL_1]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?x!fir.char<1,?>>>>>
 ! CHECK:         return
 ! CHECK:       }
 
 subroutine test_chararray(cptr, fptr, n)
   use iso_c_binding
   character(n), pointer :: fptr(:,:)
   type(c_ptr) :: cptr
   integer :: x = 3, y = 4
 
   call c_f_pointer(cptr, fptr, [x, y])
 end
+
+! CHECK-LABEL: func.func @_QPdynamic_shape_size(
+subroutine dynamic_shape_size(cptr, fptr, shape)
+  use iso_c_binding
+  type(c_ptr)  :: cptr
+  real, pointer :: fptr(:, :)
+  integer :: shape(:)
+! CHECK:         %[[VAL_7:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_8:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_7]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK:         %[[VAL_9:.*]] = fir.load %[[VAL_8]] : !fir.ref<i32>
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (i32) -> index
+! CHECK:         %[[VAL_11:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_12:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_11]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK:         %[[VAL_13:.*]] = fir.load %[[VAL_12]] : !fir.ref<i32>
+! CHECK:         %[[VAL_14:.*]] = fir.convert %[[VAL_13]] : (i32) -> index
+! CHECK:         %[[VAL_15:.*]] = fir.shape %[[VAL_10]], %[[VAL_14]] : (index, index) -> !fir.shape<2>
+  call c_f_pointer(cptr, fptr, shape)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPdynamic_shape_size_2(
+subroutine dynamic_shape_size_2(cptr, fptr, shape, n)
+  use iso_c_binding
+  type(c_ptr)  :: cptr
+  real, pointer :: fptr(:, :)
+  integer :: n
+  integer :: shape(n)
+! CHECK:         %[[VAL_8:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_8]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK:         %[[VAL_10:.*]] = fir.load %[[VAL_9]] : !fir.ref<i32>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (i32) -> index
+! CHECK:         %[[VAL_12:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_2]], %[[VAL_12]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK:         %[[VAL_14:.*]] = fir.load %[[VAL_13]] : !fir.ref<i32>
+! CHECK:         %[[VAL_15:.*]] = fir.convert %[[VAL_14]] : (i32) -> index
+! CHECK:         %[[VAL_16:.*]] = fir.shape %[[VAL_11]], %[[VAL_15]] : (index, index) -> !fir.shape<2>
+  call c_f_pointer(cptr, fptr, shape)
+end subroutine