[flang] Support lowering of intrinsic module procedure `c_loc`

[peixin]

Summary

As Fortran 2018 18.2.3.6, the intrinsic c_loc(x) gets the C address
of argument x. It returns the scalar of type C_PTR. As defined in
iso_c_binding in flang/module/__fortran_builtins.f90, C_PTR is the
derived type with only one component of integer 64.

This supports the lowering of intrinsic module procedure c_loc by
converting the address of argument into integer 64, where the argument
is lowered as Box and the address is generated using fir.box_addr.

The lowering of intrinsic c_funloc has the similar characteristic and
will be supported later.

The execution tests for various data types are in issue
https://github.com/llvm/llvm-project/issues/56552.

[clementval]

flang/include/flang/Optimizer/Dialect/FIROps.td

2861 ↗

(On Diff #444308)

Shouldn't it be ptrtoint?

flang/lib/Optimizer/CodeGen/CodeGen.cpp

2785 ↗

(On Diff #444308)

Do you really need it?

[peixin]

This is verified as follows:

$ cat c_print.c
#include <stdio.h>
void c_print_addr_(char **p) {
  printf("C Address of i = %d\n", p);
}
$ cat main.f90
PROGRAM PROG_FC_HAVE_F2003_REQUIREMENTS
  USE iso_c_binding
  IMPLICIT NONE
  TYPE(C_PTR) :: ptr
  TYPE(C_FUNPTR) :: funptr
  CHARACTER(LEN=80, KIND=c_char), TARGET :: ichr
  ptr = C_LOC(ichr(1:1))
  print *, ptr
  call c_print_addr(ichr(1:1)) 
END PROGRAM PROG_FC_HAVE_F2003_REQUIREMENTS
$ flang-new main.f90 -c
$ clang c_print.c -c
$ flang-new -flang-experimental-exec main.o c_print.o
$ a.out
C Address of i = 5293200
 5293200

flang/test/Lower/Intrinsics/c_loc.f90

38

For this case, fir::getBase(args[0]) is %54 = "fir.load"(%52) : (!fir.ref<i32>) -> i32. I am not sure if it is one bug for lowering of intrinsics. So, I add TODO for now.

[peixin]

flang/include/flang/Optimizer/Dialect/FIROps.td

2861 ↗

(On Diff #444308)

Thanks. Fixed.

flang/lib/Optimizer/CodeGen/CodeGen.cpp

2785 ↗

(On Diff #444308)

It is not necessary. Fixed.

[peixin]

flang/test/Lower/Intrinsics/c_loc.f90

38

This is because c_loc is no taken as intrinsic. Instead, it is intrinsic module procedure. The argument lowering rules are not found for intrinsic module procedures, so it uses "val" instread of "addr". Something can be shared with intrinsic (Reuse IntrinsicArgumentLoweringRules with some comment). Will prepare a new one for discussion.

[peixin]

Update the approach.

[peixin]

Rebase to fix the bot fail.

[kiranchandramohan]

Do we need the new fir.ptrtoint operation? fir.convert can generate ptrtoint llvm instructions if the source is a pointer and destination is an int. https://github.com/llvm/llvm-project/blob/74f6672e59d2cc9fdc95abfd28f527f00c808c07/flang/lib/Optimizer/CodeGen/CodeGen.cpp#L876

[peixin]

Thanks @kiranchandramohan for the notice. Reuse the fir::ConvertOp for address to integer conversion.

[peixin]

Fix one typo.

[clementval]

In D129659#3656920, @kiranchandramohan wrote:

Do we need the new fir.ptrtoint operation? fir.convert can generate ptrtoint llvm instructions if the source is a pointer and destination is an int. https://github.com/llvm/llvm-project/blob/74f6672e59d2cc9fdc95abfd28f527f00c808c07/flang/lib/Optimizer/CodeGen/CodeGen.cpp#L876

+1. I think from now on we need an RFC if we introduce new FIR operations.

[peixin]

In D129659#3658845, @clementval wrote:

In D129659#3656920, @kiranchandramohan wrote:

Do we need the new fir.ptrtoint operation? fir.convert can generate ptrtoint llvm instructions if the source is a pointer and destination is an int. https://github.com/llvm/llvm-project/blob/74f6672e59d2cc9fdc95abfd28f527f00c808c07/flang/lib/Optimizer/CodeGen/CodeGen.cpp#L876

+1. I think from now on we need an RFC if we introduce new FIR operations.

Should the description of FIR ConvertOp be changed? Its usage in CodeGen is beyond its description. Here is its description:

def fir_ConvertOp : fir_OneResultOp<"convert", [NoSideEffect]> {
  let summary = "encapsulates all Fortran scalar type conversions";

  let description = [{
    Generalized type conversion. Convert the ssa value from type T to type U.
    Not all pairs of types have conversions. When types T and U are the same
    type, this instruction is a NOP and may be folded away.

    ```mlir
      %v = ... : i64
      %w = fir.convert %v : (i64) -> i32

  The example truncates the value `%v` from an i64 to an i32.
}];

[peixin]

ping

[jeanPerier]

I do not think you need to add the BaseAddr case: you could simply lower all arguments to asBox and generate a fir.box_addr to get the address.
All variables (except variables that are designator with vector subscripts(*) ) can be lowered to a fir.box without making any copies. fir.box_addr will get you the base address in a robust way.

Now, the fir.embox + fir.box_addr may annoy you in the IR, especially with scalars where this is basically a no-op, and going via the embox looks stupid, but the good thing is that there is a canonicalizer pass that will get rid of it:

See:

func.func @test(%arg0: !fir.ref<!fir.array<10xf32>> ) {
  %0 = fir.embox %arg0 : (!fir.ref<!fir.array<10xf32>>) -> !fir.box<!fir.array<10xf32>>
  %1 = fir.box_addr %0 : (!fir.box<!fir.array<10xf32>>) -> !fir.ref<!fir.array<10xf32>>
  fir.call @bar(%1) : (!fir.ref<!fir.array<10xf32>>) -> ()
  return
}
func.func private @bar(!fir.ref<!fir.array<10xf32>> ) -> ()

fir-opt --canonicalize output:

func.func @test(%arg0: !fir.ref<!fir.array<10xf32>>) {
  fir.call @bar(%arg0) : (!fir.ref<!fir.array<10xf32>>) -> ()
  return
}
func.func private @bar(!fir.ref<!fir.array<10xf32>>)

So I think relying on asBox + fir.box_addr will make lowering a lot simpler an robust at no extra runtime cost for C_LOC lowering.

(*) I think having a variable that is designator with vector subscript in C_LOC would be most likely illegal: it does not have the "Target" attribute (it cannot be pointed at in a pointer assignment). Ifort and gfortran are not enforcing this, but xlf and NAG are. @klausler, do you agree we should forbid designator with vector subscripts in C_LOC on the motive that they cannot possibly be targets ?

flang/lib/Lower/ConvertExpr.cpp

2296 ↗

(On Diff #445206)

prepareActualToBaseAddressLike is inserting copy-in when the arguments are not simply contiguous when passing to explicit shape arguments, we do not need/want that here: we should pass the base address and not deal with the case where the argument is not contiguous (the standard says it must be contiguous, although that is something that could only be checked at compile time, and I have a feeling some programmers out there might rely on getting the base first element address, whether the argument is contiguous or not).

flang/test/Lower/Intrinsics/c_loc.f90

14

Please only add checks relevant to what you are testing here and below. We do not care much about the allocation/assignment here, it is actually a bit confusing since it looks like c_loc lowering is doing a lot of copies...

314

I am actually surprised this case and some other in your file are accepted by semantics. According to the standard about c_loc (18.2.3.6 point 3): X shall have either the POINTER or TARGET attribute. I cannot find an extension in https://github.com/llvm/llvm-project/blob/main/flang/docs/Extensions.md.

@klausler, we want to enforce this, right ?

[peixin]

Thanks @jeanPerier for the detailed explanations. Let me take a try with asBox as suggested.

flang/test/Lower/Intrinsics/c_loc.f90

314

Like what I said in the summary, gfortran does not support allocatable variables or variables without pointer/target attribute and emits one semantic error. ifort support them.

Currently, there is only semantic check of implicit interface for c_loc (https://github.com/llvm/llvm-project/blob/1f5144cdbbab3b86795903a10180c85d7e586e93/flang/lib/Semantics/check-call.cpp#L27-L49). I also filed one issue for assumed type and derived type with kind type paramter in c_loc (https://github.com/llvm/llvm-project/issues/56553).

Should the semantic checks for intrinsics be separated from CheckImplicitInterfaceArg to handle the above cases? Or some better ideas?

[klausler]

I think having a variable that is designator with vector subscript in C_LOC would be most likely illegal: it does not have the "Target" attribute (it cannot be pointed at in a pointer assignment). Ifort and gfortran are not enforcing this, but xlf and NAG are. @klausler, do you agree we should forbid designator with vector subscripts in C_LOC on the motive that they cannot possibly be targets ?

The standard does not exclude variables with vector subscripts from appearing as C_LOC arguments, but since they clearly can't be targets, we should disallow them. The standard does disallow such variables from being data-targets in pointer assignments.

[peixin]

Address the comments:

1. Use asBox for the argument.
2. Remove the unused file check IRs as suggested.
3. Remove the test cases without pointer/target attribute, which may should have semantic error. For now, I am not sure since the standard also says "if it is allocatable, it shall be allocated. If it is a pointer, it shall be associated.". This seems to be contradictory. This can be delayed until supporting the semantic checks for c_loc.

and I have a feeling some programmers out there might rely on getting the base first element address, whether the argument is contiguous or not).

Agree.

[jeanPerier]

Thanks, that looks good to me, just one question about the TODO and a related suggestion.

flang/lib/Lower/IntrinsicCall.cpp

2398–2407

I do not fully understand why the POINTER case is left TODO, shouldn't it be handled in the same way ?

If the issue id to get the right memory type, I suggest you use BoxValue::getMemTy():

const auto*box = args[0].getBoxOf<fir::BoxValue>();
assert(box && "c_loc arg must have been lowered to a fir.box");
mlir::Value argAddr = builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), fir::getBase(*box)));

This will ensure the fir.heap/fir.ptr aspect are kept in the BoxAddrOp result.

[peixin]

Use BoxValue::getMemTy() as suggested.

[peixin]

I do not fully understand why the POINTER case is left TODO, shouldn't it be handled in the same way ?

The execution of the following case is:

$ cat a.f90 
program main
  use iso_c_binding
  type(c_ptr) :: ptr
  integer, pointer :: a(:)
  allocate(a(10))
  a = 10
  ptr = c_loc(a)
  print *, "Fortran data = ", a(1)
  print *, "Fortran address = ", ptr
  call c_print_addr(a)
end
$ cat b.c 
#include <stdio.h>

void c_print_addr_(int ***p) {
  printf("C data = %d\n", *p);
  printf("C Address = %d\n", p);
}
$ flang-new a.f90 -c
$ clang b.c -c -w
$ flang-new -flang-experimental-exec a.o b.o
$ ./a.out
C data = 10
C Address = 14530256
 Fortran data =  10
 Fortran address =  14451360

It seems the problem is not lowering of c_loc. The generated FIR for a.f90 is as follows:

%0 = fir.address_of(@_QFEa) : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
%15 = fir.load %0 : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
%16 = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
%17 = fir.box_addr %15 : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
%18 = fir.convert %17 : (!fir.ptr<!fir.array<?xi32>>) -> i64
%19 = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
%20 = fir.coordinate_of %16, %19 : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
fir.store %18 to %20 : !fir.ref<i64>
%29 = fir.allocmem !fir.array<?xi32>, %28#1 {uniq_name = ".copyinout"}
%36 = fir.convert %29 : (!fir.heap<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
fir.call @_QPc_print_addr(%36) : (!fir.ref<!fir.array<?xi32>>) -> ()

Currently, I have no idea how to fix this problem. It seems that the lowering of passing pointer array as argument should be fixed.

[jeanPerier]

In D129659#3687803, @peixin wrote:

Currently, I have no idea how to fix this problem. It seems that the lowering of passing pointer array as argument should be fixed.

Yes, that has nothing to do with c_loc lowering indeed. What you are seeing is the copy-in/copy-out of the pointer array, that may be non contiguous, and is passed to an explicit shape array (according to the implicit interface). F18 lowering currently does not make the copy-in/copy-out conditional at runtime. The runtime to check contiguity was added and should be used to make copy-in/copy-out conditional at runtime on the actual contiguity.

Technically, I think the expectations of your program that the array address inside c_print_addr be the same as its argument is wrong because its dummy argument does not have the target attribute, and even if it had, it should be an assumed shape with the CONTIGUOUS attribute, or the actual argument should be simply contiguous (contiguity that can be deduced at compile time) which is not the case here. Fortran 2018 section 15.5.2.4 point 8 and 9 do not guarantee the address will be what you expect in those case, although all compiler will yield the expected result for obvious performance incentive (why making an array copy when we do not need to ?), and this should be updated in lowering at some point.

Anyway, I do not think c_loc deserve a TODO because of that for pointers, this is unrelated and C_LOC works (you can verify this by doing c_print_addr(a(lbound(a,1))) instead of c_print_addr(a)).

[peixin]

Technically, I think the expectations of your program that the array address inside c_print_addr be the same as its argument is wrong because its dummy argument does not have the target attribute, and even if it had, it should be an assumed shape with the CONTIGUOUS attribute, or the actual argument should be simply contiguous (contiguity that can be deduced at compile time) which is not the case here. Fortran 2018 section 15.5.2.4 point 8 and 9 do not guarantee the address will be what you expect in those case, although all compiler will yield the expected result for obvious performance incentive (why making an array copy when we do not need to ?), and this should be updated in lowering at some point.

Got it. Thanks. Will remove the TODO.

[peixin]

Remove the TODO for pointer array and add the test case for it.

[jeanPerier]

Looks good to me, thanks !

[PeteSteinfeld]

Note issue https://github.com/llvm/llvm-project/issues/58739

[peixin]

In D129659#3900151, @PeteSteinfeld wrote:

Note issue https://github.com/llvm/llvm-project/issues/58739

Thanks. Will take a look.

flang/lib/Lower/IntrinsicCall.cpp

struct IntrinsicLibrary {
   template <mlir::arith::CmpIPredicate pred>
   fir::ExtendedValue genCharacterCompare(mlir::Type,
                                          llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genCmplx(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genConjg(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genCount(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genCpuTime(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genCshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
+  fir::ExtendedValue genCLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   void genDateAndTime(llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genDim(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genDotProduct(mlir::Type,
                                    llvm::ArrayRef<fir::ExtendedValue>);
   mlir::Value genDprod(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genDshiftl(mlir::Type, llvm::ArrayRef<mlir::Value>);
   mlir::Value genDshiftr(mlir::Type, llvm::ArrayRef<mlir::Value>);
   fir::ExtendedValue genEoshift(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);

 
 struct IntrinsicDummyArgument {
   const char *name = nullptr;
   Fortran::lower::LowerIntrinsicArgAs lowerAs =
       Fortran::lower::LowerIntrinsicArgAs::Value;
   bool handleDynamicOptional = false;
 };
 
+/// This is shared by intrinsics and intrinsic module procedures.
 struct Fortran::lower::IntrinsicArgumentLoweringRules {
   /// There is no more than 7 non repeated arguments in Fortran intrinsics.
   IntrinsicDummyArgument args[7];
   constexpr bool hasDefaultRules() const { return args[0].name == nullptr; }
 };
 
-/// Structure describing what needs to be done to lower intrinsic "name".
+/// Structure describing what needs to be done to lower intrinsic or intrinsic
+/// module procedure "name".
 struct IntrinsicHandler {
   const char *name;
   IntrinsicLibrary::Generator generator;
   // The following may be omitted in the table below.
   Fortran::lower::IntrinsicArgumentLoweringRules argLoweringRules = {};
   bool isElemental = true;
   /// Code heavy intrinsic can be outlined to make FIR
   /// more readable.
   bool outline = false;
 };
 
 constexpr auto asValue = Fortran::lower::LowerIntrinsicArgAs::Value;
 constexpr auto asAddr = Fortran::lower::LowerIntrinsicArgAs::Addr;
 constexpr auto asBox = Fortran::lower::LowerIntrinsicArgAs::Box;
 constexpr auto asInquired = Fortran::lower::LowerIntrinsicArgAs::Inquired;
 using I = IntrinsicLibrary;
 
 /// Flag to indicate that an intrinsic argument has to be handled as
 /// being dynamically optional (e.g. special handling when actual
 /// argument is an optional variable in the current scope).
 static constexpr bool handleDynamicOptional = true;
 
-/// Table that drives the fir generation depending on the intrinsic.
-/// one to one mapping with Fortran arguments. If no mapping is
+/// Table that drives the fir generation depending on the intrinsic or intrinsic
+/// module procedure one to one mapping with Fortran arguments. If no mapping is
 /// defined here for a generic intrinsic, genRuntimeCall will be called
 /// to look for a match in the runtime a emit a call. Note that the argument
 /// lowering rules for an intrinsic need to be provided only if at least one
 /// argument must not be lowered by value. In which case, the lowering rules
 /// should be provided for all the intrinsic arguments for completeness.
 static constexpr IntrinsicHandler handlers[]{
     {"abs", &I::genAbs},
     {"achar", &I::genChar},
static constexpr IntrinsicHandler handlers[]{
      &I::genAssociated,
      {{{"pointer", asInquired}, {"target", asInquired}}},
      /*isElemental=*/false},
     {"bge", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::uge>},
     {"bgt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ugt>},
     {"ble", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ule>},
     {"blt", &I::genBitwiseCompare<mlir::arith::CmpIPredicate::ult>},
     {"btest", &I::genBtest},
+    {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},
     {"ceiling", &I::genCeiling},
     {"char", &I::genChar},
     {"cmplx",
      &I::genCmplx,
      {{{"x", asValue}, {"y", asValue, handleDynamicOptional}}}},
     {"command_argument_count", &I::genCommandArgumentCount},
     {"conjg", &I::genConjg},
     {"count",
mlir::Value IntrinsicLibrary::genBtest(mlir::Type resultType,
   mlir::Type argType = args[0].getType();
   mlir::Value pos = builder.createConvert(loc, argType, args[1]);
   auto shift = builder.create<mlir::arith::ShRUIOp>(loc, args[0], pos);
   mlir::Value one = builder.createIntegerConstant(loc, argType, 1);
   auto res = builder.create<mlir::arith::AndIOp>(loc, shift, one);
   return builder.createConvert(loc, resultType, res);
 }
 
+// C_LOC
+fir::ExtendedValue
+IntrinsicLibrary::genCLoc(mlir::Type resultType,
+                          llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 1 && resultType.isa<fir::RecordType>());
+  auto resTy = resultType.dyn_cast<fir::RecordType>();
+  assert(resTy.getTypeList().size() == 1);
+  auto fieldName = resTy.getTypeList()[0].first;
+  auto fieldTy = resTy.getTypeList()[0].second;
+  mlir::Value res = builder.create<fir::AllocaOp>(loc, resultType);
+  const auto *box = args[0].getBoxOf<fir::BoxValue>();
+  assert(box && "c_loc argument must have been lowered to a fix.box");
+  mlir::Value argAddr =
+      builder.create<fir::BoxAddrOp>(loc, box->getMemTy(), fir::getBase(*box));
+  mlir::Value argAddrVal = builder.createConvert(loc, fieldTy, argAddr);
+  auto fieldIndexType = fir::FieldType::get(resultType.getContext());
+  mlir::Value field = builder.create<fir::FieldIndexOp>(
+      loc, fieldIndexType, fieldName, resTy, /*typeParams=*/mlir::ValueRange{});
+  mlir::Value resAddr = builder.create<fir::CoordinateOp>(
+      loc, builder.getRefType(fieldTy), res, field);
+  builder.create<fir::StoreOp>(loc, argAddrVal, resAddr);
+  return res;
+}
+
 // CEILING
 mlir::Value IntrinsicLibrary::genCeiling(mlir::Type resultType,
                                          llvm::ArrayRef<mlir::Value> args) {
   // Optional KIND argument.
   assert(args.size() >= 1);
   mlir::Value arg = args[0];
   // Use ceil that is not an actual Fortran intrinsic but that is
   // an llvm intrinsic that does the same, but return a floating
for (auto arg : args.drop_front()) {
     mlir::Value mask =
         createExtremumCompare<extremum, behavior>(loc, builder, result, arg);
     result = builder.create<mlir::arith::SelectOp>(loc, mask, result, arg);
   }
   return result;
 }
 
 //===----------------------------------------------------------------------===//
-// Argument lowering rules interface
+// Argument lowering rules interface for intrinsic or intrinsic module
+// procedure.
 //===----------------------------------------------------------------------===//
 
 const Fortran::lower::IntrinsicArgumentLoweringRules *
-Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef intrinsicName) {
-  if (const IntrinsicHandler *handler = findIntrinsicHandler(intrinsicName))
+Fortran::lower::getIntrinsicArgumentLowering(llvm::StringRef specificName) {
+  llvm::StringRef name = genericName(specificName);
+  if (const IntrinsicHandler *handler = findIntrinsicHandler(name))
     if (!handler->argLoweringRules.hasDefaultRules())
       return &handler->argLoweringRules;
   return nullptr;
 }
 
 /// Return how argument \p argName should be lowered given the rules for the
 /// intrinsic function.
 Fortran::lower::ArgLoweringRule Fortran::lower::lowerIntrinsicArgumentAs(

flang/test/Lower/Intrinsics/c_loc.f90

+! RUN: bbc -emit-fir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-fir %s -o - | FileCheck %s
+
+! Test intrinsic module procedure c_loc
+
+! CHECK-LABEL: func.func @_QPc_loc_scalar() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_scalarEi) : !fir.ref<i32>
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_scalarEptr"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_4:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_5]] to %[[VAL_7]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_scalar()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer, target :: i = 10
+  ptr = c_loc(i)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_char() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_charEichr) : !fir.ref<!fir.char<1,5>>
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_charEptr"}
+! CHECK:         %[[VAL_2:.*]] = fir.embox %[[VAL_0]] : (!fir.ref<!fir.char<1,5>>) -> !fir.box<!fir.char<1,5>>
+! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_4:.*]] = fir.box_addr %[[VAL_2]] : (!fir.box<!fir.char<1,5>>) -> !fir.ref<!fir.char<1,5>>
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.ref<!fir.char<1,5>>) -> i64
+! CHECK:         %[[VAL_6:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_7:.*]] = fir.coordinate_of %[[VAL_3]], %[[VAL_6]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_5]] to %[[VAL_7]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_char()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  character(5, kind=c_char), target :: ichr = "abcde"
+  ptr = c_loc(ichr)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_substring() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_substringEichr) : !fir.ref<!fir.char<1,5>>
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_substringEptr"}
+! CHECK:         %[[VAL_2:.*]] = arith.constant 2 : i64
+! CHECK:         %[[VAL_3:.*]] = arith.constant 5 : i64
+! CHECK:         %[[VAL_4:.*]] = fir.convert %[[VAL_2]] : (i64) -> index
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_3]] : (i64) -> index
+! CHECK:         %[[VAL_6:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_7:.*]] = arith.subi %[[VAL_4]], %[[VAL_6]] : index
+! CHECK:         %[[VAL_8:.*]] = fir.convert %[[VAL_0]] : (!fir.ref<!fir.char<1,5>>) -> !fir.ref<!fir.array<5x!fir.char<1>>>
+! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_8]], %[[VAL_7]] : (!fir.ref<!fir.array<5x!fir.char<1>>>, index) -> !fir.ref<!fir.char<1>>
+! CHECK:         %[[VAL_10:.*]] = fir.convert %[[VAL_9]] : (!fir.ref<!fir.char<1>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_11:.*]] = arith.subi %[[VAL_5]], %[[VAL_4]] : index
+! CHECK:         %[[VAL_12:.*]] = arith.addi %[[VAL_11]], %[[VAL_6]] : index
+! CHECK:         %[[VAL_13:.*]] = arith.constant 0 : index
+! CHECK:         %[[VAL_14:.*]] = arith.cmpi slt, %[[VAL_12]], %[[VAL_13]] : index
+! CHECK:         %[[VAL_15:.*]] = arith.select %[[VAL_14]], %[[VAL_13]], %[[VAL_12]] : index
+! CHECK:         %[[VAL_16:.*]] = fir.embox %[[VAL_10]] typeparams %[[VAL_15]] : (!fir.ref<!fir.char<1,?>>, index) -> !fir.box<!fir.char<1,?>>
+! CHECK:         %[[VAL_17:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_18:.*]] = fir.box_addr %[[VAL_16]] : (!fir.box<!fir.char<1,?>>) -> !fir.ref<!fir.char<1,?>>
+! CHECK:         %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (!fir.ref<!fir.char<1,?>>) -> i64
+! CHECK:         %[[VAL_20:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_21:.*]] = fir.coordinate_of %[[VAL_17]], %[[VAL_20]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_19]] to %[[VAL_21]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_substring()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  character(5, kind=c_char), target :: ichr = "abcde"
+  ptr = c_loc(ichr(2:))
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_array() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_arrayEa) : !fir.ref<!fir.array<10xi32>>
+! CHECK:         %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arrayEptr"}
+! CHECK:         %[[VAL_3:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_4:.*]] = fir.embox %[[VAL_0]](%[[VAL_3]]) : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>) -> !fir.box<!fir.array<10xi32>>
+! CHECK:         %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_6:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.array<10xi32>>) -> !fir.ref<!fir.array<10xi32>>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.array<10xi32>>) -> i64
+! CHECK:         %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_8]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_7]] to %[[VAL_9]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_array
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer, target :: a(10) = 10
+  ptr = c_loc(a)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_chararray() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_chararrayEichr) : !fir.ref<!fir.array<2x!fir.char<1,5>>>
+! CHECK:         %[[VAL_1:.*]] = arith.constant 2 : index
+! CHECK:         %[[VAL_2:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_chararrayEptr"}
+! CHECK:         %[[VAL_3:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_4:.*]] = fir.embox %[[VAL_0]](%[[VAL_3]]) : (!fir.ref<!fir.array<2x!fir.char<1,5>>>, !fir.shape<1>) -> !fir.box<!fir.array<2x!fir.char<1,5>>>
+! CHECK:         %[[VAL_5:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_6:.*]] = fir.box_addr %[[VAL_4]] : (!fir.box<!fir.array<2x!fir.char<1,5>>>) -> !fir.ref<!fir.array<2x!fir.char<1,5>>>
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (!fir.ref<!fir.array<2x!fir.char<1,5>>>) -> i64
+! CHECK:         %[[VAL_8:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_9:.*]] = fir.coordinate_of %[[VAL_5]], %[[VAL_8]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_7]] to %[[VAL_9]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_chararray()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  character(5, kind=c_char), target :: ichr(2) = "abcde"
+  ptr = c_loc(ichr)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_arrayelement() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_arrayelementEa) : !fir.ref<!fir.array<10xi32>>
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arrayelementEptr"}
+! CHECK:         %[[VAL_2:.*]] = arith.constant 2 : i64
+! CHECK:         %[[VAL_3:.*]] = arith.constant 1 : i64
+! CHECK:         %[[VAL_4:.*]] = arith.subi %[[VAL_2]], %[[VAL_3]] : i64
+! CHECK:         %[[VAL_5:.*]] = fir.coordinate_of %[[VAL_0]], %[[VAL_4]] : (!fir.ref<!fir.array<10xi32>>, i64) -> !fir.ref<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.embox %[[VAL_5]] : (!fir.ref<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_7:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_8:.*]] = fir.box_addr %[[VAL_6]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_10:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_11:.*]] = fir.coordinate_of %[[VAL_7]], %[[VAL_10]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_9]] to %[[VAL_11]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_arrayelement()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer, target :: a(10) = 10
+  ptr = c_loc(a(2))
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_arraysection() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_arraysectionEa) : !fir.ref<!fir.array<10xi32>>
+! CHECK:         %[[VAL_1:.*]] = arith.constant 10 : index
+! CHECK:         %[[VAL_2:.*]] = fir.address_of(@_QFc_loc_arraysectionEind) : !fir.ref<i32>
+! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_arraysectionEptr"}
+! CHECK:         %[[VAL_4:.*]] = arith.constant 1 : index
+! CHECK:         %[[VAL_5:.*]] = fir.load %[[VAL_2]] : !fir.ref<i32>
+! CHECK:         %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i32) -> i64
+! CHECK:         %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> index
+! CHECK:         %[[VAL_8:.*]] = arith.constant 1 : i64
+! CHECK:         %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i64) -> index
+! CHECK:         %[[VAL_10:.*]] = arith.addi %[[VAL_4]], %[[VAL_1]] : index
+! CHECK:         %[[VAL_11:.*]] = arith.subi %[[VAL_10]], %[[VAL_4]] : index
+! CHECK:         %[[VAL_12:.*]] = fir.shape %[[VAL_1]] : (index) -> !fir.shape<1>
+! CHECK:         %[[VAL_13:.*]] = fir.slice %[[VAL_7]], %[[VAL_11]], %[[VAL_9]] : (index, index, index) -> !fir.slice<1>
+! CHECK:         %[[VAL_14:.*]] = fir.embox %[[VAL_0]](%[[VAL_12]]) {{\[}}%[[VAL_13]]] : (!fir.ref<!fir.array<10xi32>>, !fir.shape<1>, !fir.slice<1>) -> !fir.box<!fir.array<?xi32>>
+! CHECK:         %[[VAL_15:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_16:.*]] = fir.box_addr %[[VAL_14]] : (!fir.box<!fir.array<?xi32>>) -> !fir.ref<!fir.array<?xi32>>
+! CHECK:         %[[VAL_17:.*]] = fir.convert %[[VAL_16]] : (!fir.ref<!fir.array<?xi32>>) -> i64
+! CHECK:         %[[VAL_18:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_19:.*]] = fir.coordinate_of %[[VAL_15]], %[[VAL_18]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_17]] to %[[VAL_19]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_arraysection()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer :: ind = 3
+  integer, target :: a(10) = 10
+  ptr = c_loc(a(ind:))
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_non_save_pointer_scalar() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<i32>> {bindc_name = "i", uniq_name = "_QFc_loc_non_save_pointer_scalarEi"}
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.ptr<i32> {uniq_name = "_QFc_loc_non_save_pointer_scalarEi.addr"}
+! CHECK:         %[[VAL_2:.*]] = fir.zero_bits !fir.ptr<i32>
+! CHECK:         fir.store %[[VAL_2]] to %[[VAL_1]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:         %[[VAL_3:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}> {bindc_name = "ptr", uniq_name = "_QFc_loc_non_save_pointer_scalarEptr"}
+! CHECK:         %[[VAL_4:.*]] = fir.allocmem i32 {uniq_name = "_QFc_loc_non_save_pointer_scalarEi.alloc"}
+! CHECK:         %[[VAL_5:.*]] = fir.convert %[[VAL_4]] : (!fir.heap<i32>) -> !fir.ptr<i32>
+! CHECK:         fir.store %[[VAL_5]] to %[[VAL_1]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:         %[[VAL_6:.*]] = arith.constant 10 : i32
+! CHECK:         %[[VAL_7:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:         fir.store %[[VAL_6]] to %[[VAL_7]] : !fir.ptr<i32>
+! CHECK:         %[[VAL_8:.*]] = fir.load %[[VAL_1]] : !fir.ref<!fir.ptr<i32>>
+! CHECK:         %[[VAL_9:.*]] = fir.embox %[[VAL_8]] : (!fir.ptr<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_10:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_11:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_10]], %[[VAL_13]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_12]] to %[[VAL_14]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_non_save_pointer_scalar()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer, pointer :: i
+  allocate(i)
+  i = 10
+  ptr = c_loc(i)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_save_pointer_scalar() {
+! CHECK:         %[[VAL_0:.*]] = fir.address_of(@_QFc_loc_save_pointer_scalarEi) : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:         %[[VAL_7:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<i32>>>
+! CHECK:         %[[VAL_8:.*]] = fir.box_addr %[[VAL_7]] : (!fir.box<!fir.ptr<i32>>) -> !fir.ptr<i32>
+! CHECK:         %[[VAL_9:.*]] = fir.embox %[[VAL_8:.*]] : (!fir.ptr<i32>) -> !fir.box<i32>
+! CHECK:         %[[VAL_10:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_11:.*]] = fir.box_addr %[[VAL_9]] : (!fir.box<i32>) -> !fir.ref<i32>
+! CHECK:         %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (!fir.ref<i32>) -> i64
+! CHECK:         %[[VAL_13:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_14:.*]] = fir.coordinate_of %[[VAL_10]], %[[VAL_13]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_12]] to %[[VAL_14]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_save_pointer_scalar()
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer, pointer, save :: i
+  allocate(i)
+  i = 10
+  ptr = c_loc(i)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_derived_type() {
+! CHECK:         %[[VAL_1:.*]] = fir.alloca !fir.type<_QFc_loc_derived_typeTt{i:i32}> {bindc_name = "tt", fir.target, uniq_name = "_QFc_loc_derived_typeEtt"}
+! CHECK:         %[[VAL_8:.*]] = fir.embox %[[VAL_1]] : (!fir.ref<!fir.type<_QFc_loc_derived_typeTt{i:i32}>>) -> !fir.box<!fir.type<_QFc_loc_derived_typeTt{i:i32}>>
+! CHECK:         %[[VAL_9:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_10:.*]] = fir.box_addr %[[VAL_8:.*]] : (!fir.box<!fir.type<_QFc_loc_derived_typeTt{i:i32}>>) -> !fir.ref<!fir.type<_QFc_loc_derived_typeTt{i:i32}>>
+! CHECK:         %[[VAL_11:.*]] = fir.convert %[[VAL_10]] : (!fir.ref<!fir.type<_QFc_loc_derived_typeTt{i:i32}>>) -> i64
+! CHECK:         %[[VAL_12:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_13:.*]] = fir.coordinate_of %[[VAL_9]], %[[VAL_12]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_11]] to %[[VAL_13]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_derived_type
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  type t
+    integer :: i = 1
+  end type
+  type(t), target :: tt
+  ptr = c_loc(tt)
+end
+
+! CHECK-LABEL: func.func @_QPc_loc_pointer_array() {
+! CHECK:         %[[VAL_0:.*]] = fir.alloca !fir.box<!fir.ptr<!fir.array<?xi32>>> {bindc_name = "a", uniq_name = "_QFc_loc_pointer_arrayEa"}
+! CHECK:         %[[VAL_30:.*]] = fir.load %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?xi32>>>>
+! CHECK:         %[[VAL_31:.*]] = fir.alloca !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_32:.*]] = fir.box_addr %[[VAL_30:.*]] : (!fir.box<!fir.ptr<!fir.array<?xi32>>>) -> !fir.ptr<!fir.array<?xi32>>
+! CHECK:         %[[VAL_33:.*]] = fir.convert %[[VAL_32]] : (!fir.ptr<!fir.array<?xi32>>) -> i64
+! CHECK:         %[[VAL_34:.*]] = fir.field_index __address, !fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>
+! CHECK:         %[[VAL_35:.*]] = fir.coordinate_of %[[VAL_31]], %[[VAL_34]] : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>, !fir.field) -> !fir.ref<i64>
+! CHECK:         fir.store %[[VAL_33]] to %[[VAL_35]] : !fir.ref<i64>
+! CHECK:       }
+
+subroutine c_loc_pointer_array
+  use iso_c_binding
+  type(c_ptr) :: ptr
+  integer, pointer :: a(:)
+  allocate(a(10))
+  a = 10
+  ptr = c_loc(a)
+end