[Flang] Implement LOWER= argument for C_F_POINTER (Fortran 2023) #149870

mjklemm · 2025-07-21T18:53:45Z

This PR resolves issue #147819 and adds support for the F2023 extension of the LOWER= argument for C_F_POINTER.

This PR adds support for the optional LOWER argument for C_F_POINTER (Fortran 2023, 18.2.3.3)

llvmbot · 2025-07-21T18:54:16Z

@llvm/pr-subscribers-flang-semantics

Author: Michael Klemm (mjklemm)

Changes

This PR resolves issue #147819 and adds support for the F2023 extension of the LOWER= argument for C_F_POINTER.

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

5 Files Affected:

(modified) flang/docs/F202X.md (-1)
(modified) flang/lib/Evaluate/intrinsics.cpp (+40-4)
(modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+22-4)
(modified) flang/test/Lower/Intrinsics/c_f_pointer.f90 (+75)
(modified) flang/test/Semantics/c_f_pointer.f90 (+8)

diff --git a/flang/docs/F202X.md b/flang/docs/F202X.md
index 67ea7fd97449a..7504561a64aa6 100644
--- a/flang/docs/F202X.md
+++ b/flang/docs/F202X.md
@@ -268,7 +268,6 @@ Addressing some issues and omissions in intrinsic modules:
  * LOGICAL8/16/32/64 and REAL16
  * IEEE module facilities upgraded to match latest IEEE FP standard
  * C_F_STRPOINTER, F_C_STRING for NUL-terminated strings
- * C_F_POINTER(LOWER=)
 
 #### Intrinsic Procedure Extensions
 
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 9957010684d48..c48dea4b54b3a 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3073,10 +3073,11 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
     ActualArguments &arguments, FoldingContext &context) const {
   characteristics::Procedure::Attrs attrs;
   attrs.set(characteristics::Procedure::Attr::Subroutine);
-  static const char *const keywords[]{"cptr", "fptr", "shape", nullptr};
+  static const char *const keywords[]{
+      "cptr", "fptr", "shape", "lower", nullptr};
   characteristics::DummyArguments dummies;
-  if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) {
-    CHECK(arguments.size() == 3);
+  if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 2)) {
+    CHECK(arguments.size() == 4);
     if (const auto *expr{arguments[0].value().UnwrapExpr()}) {
       // General semantic checks will catch an actual argument that's not
       // scalar.
@@ -3169,11 +3170,30 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
           }
         }
       }
+      if (arguments[3] && fptrRank == 0) {
+        context.messages().Say(arguments[3]->sourceLocation(),
+            "LOWER= argument to C_F_POINTER() may not appear when FPTR= is scalar"_err_en_US);
+      } else if (arguments[3]) {
+        if (const auto *argExpr{arguments[3].value().UnwrapExpr()}) {
+          if (argExpr->Rank() > 1) {
+            context.messages().Say(arguments[3]->sourceLocation(),
+                "LOWER= argument to C_F_POINTER() must be a rank-one array."_err_en_US);
+          } else if (argExpr->Rank() == 1) {
+            if (auto constShape{GetConstantShape(context, *argExpr)}) {
+              if (constShape->At(ConstantSubscripts{1}).ToInt64() != fptrRank) {
+                context.messages().Say(arguments[3]->sourceLocation(),
+                    "LOWER= argument to C_F_POINTER() must have size equal to the rank of FPTR="_err_en_US);
+              }
+            }
+          }
+        }
+      }
     }
   }
   if (dummies.size() == 2) {
+    // Handle SHAPE
     DynamicType shapeType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
-    if (arguments[2]) {
+    if (arguments.size() >=3 && arguments[2]) {
       if (auto type{arguments[2]->GetType()}) {
         if (type->category() == TypeCategory::Integer) {
           shapeType = *type;
@@ -3185,6 +3205,22 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
     shape.intent = common::Intent::In;
     shape.attrs.set(characteristics::DummyDataObject::Attr::Optional);
     dummies.emplace_back("shape"s, std::move(shape));
+
+    // Handle LOWER
+    DynamicType lowerType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
+    if (arguments.size() >= 4 && arguments[3]) {
+      if (auto type{arguments[3]->GetType()}) {
+        if (type->category() == TypeCategory::Integer) {
+          lowerType = *type;
+        }
+      }
+    }
+    characteristics::DummyDataObject lower{
+        characteristics::TypeAndShape{lowerType, 1}};
+    lower.intent = common::Intent::In;
+    lower.attrs.set(characteristics::DummyDataObject::Attr::Optional);
+    dummies.emplace_back("lower"s, std::move(lower));
+
     return SpecificCall{
         SpecificIntrinsic{"__builtin_c_f_pointer"s,
             characteristics::Procedure{std::move(dummies), attrs}},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index d77a656158a37..a99c4cb112c21 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -369,7 +369,8 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genCFPointer,
      {{{"cptr", asValue},
        {"fptr", asInquired},
-       {"shape", asAddr, handleDynamicOptional}}},
+       {"shape", asAddr, handleDynamicOptional},
+       {"lower", asAddr, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"c_f_procpointer",
      &I::genCFProcPointer,
@@ -3403,7 +3404,7 @@ IntrinsicLibrary::genCDevLoc(mlir::Type resultType,
 
 // C_F_POINTER
 void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
-  assert(args.size() == 3);
+  assert(args.size() == 4);
   // Handle CPTR argument
   // Get the value of the C address or the result of a reference to C_LOC.
   mlir::Value cPtr = fir::getBase(args[0]);
@@ -3418,9 +3419,12 @@ void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
     mlir::Value addr =
         builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);
     mlir::SmallVector<mlir::Value> extents;
+    mlir::SmallVector<mlir::Value> lbounds;
     if (box.hasRank()) {
       assert(isStaticallyPresent(args[2]) &&
              "FPTR argument must be an array if SHAPE argument exists");
+
+      // Handle and unpack SHAPE argument
       mlir::Value shape = fir::getBase(args[2]);
       int arrayRank = box.rank();
       mlir::Type shapeElementType =
@@ -3433,17 +3437,31 @@ void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
         mlir::Value load = builder.create<fir::LoadOp>(loc, var);
         extents.push_back(builder.createConvert(loc, idxType, load));
       }
+
+      // Handle and unpack LOWER argument if present
+      if (isStaticallyPresent(args[3])) {
+        mlir::Value lower = fir::getBase(args[3]);
+        mlir::Type lowerElementType =
+            fir::unwrapSequenceType(fir::unwrapPassByRefType(lower.getType()));
+        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(lowerElementType), lower, index);
+          mlir::Value load = builder.create<fir::LoadOp>(loc, var);
+          lbounds.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::CharArrayBoxValue{addr, len, extents, lbounds};
       return fir::CharBoxValue{addr, len};
     }
     if (box.isDerivedWithLenParameters())
       TODO(loc, "get length parameters of derived type");
     if (box.hasRank())
-      return fir::ArrayBoxValue{addr, extents};
+      return fir::ArrayBoxValue{addr, extents, lbounds};
     return addr;
   };
 
diff --git a/flang/test/Lower/Intrinsics/c_f_pointer.f90 b/flang/test/Lower/Intrinsics/c_f_pointer.f90
index 67817e39d5c2b..f41d5e471f540 100644
--- a/flang/test/Lower/Intrinsics/c_f_pointer.f90
+++ b/flang/test/Lower/Intrinsics/c_f_pointer.f90
@@ -140,3 +140,78 @@ subroutine dynamic_shape_size_2(cptr, fptr, shape, n)
 ! CHECK:         %[[VAL_16:.*]] = fir.shape %[[VAL_11]], %[[VAL_15]] : (index, index) -> !fir.shape<2>
   call c_f_pointer(cptr, fptr, shape)
 end subroutine
+
+! CHECK-LABEL: func.func @_QPdynamic_shape_lower(
+subroutine dynamic_shape_lower(cptr, fpr, shape, lower)
+  use iso_c_binding
+  type(c_ptr)  :: cptr
+  real, pointer :: fptr(:, :)
+  integer :: n
+  integer :: shape(:)
+  integer :: lower(:)
+! CHECK: %[[C_0:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_2:.*]] = fir.shape %[[C_0]], %[[C_0]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1:.*]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK: fir.store %[[VAL_3]] to %[[VAL_0:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+! CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFdynamic_shape_lowerEn"}
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[ARG_0:.*]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<i64>
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>
+! CHECK: %[[C_0:.*]]_0 = arith.constant 0 : index
+! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_0]]_0 : (!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: %[[C_1:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_11:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_1]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_11]] : !fir.ref<i32>
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i32) -> index
+! CHECK: %[[C_0:.*]]_1 = arith.constant 0 : index
+! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_0]]_1 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<i32>
+! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> index
+! CHECK: %[[C_1:.*]]_2 = arith.constant 1 : index
+! CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_1]]_2 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_17]] : !fir.ref<i32>
+! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> index
+! CHECK: %[[VAL_20:.*]] = fir.shape_shift %[[VAL_16]], %[[VAL_10]], %[[VAL_19]], %[[VAL_13]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_7]](%[[VAL_20]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK: fir.store %[[VAL_21:.*]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  call c_f_pointer(cptr, fptr, shape, lower)
+end subroutine dynamic_shape_lower
+
+! CHECK-LABEL: func.func @_QPdynamic_shape_lower_2(
+subroutine dynamic_shape_lower_2(cptr, fpr, shape, lower, n)
+  use iso_c_binding
+  type(c_ptr)  :: cptr
+  real, pointer :: fptr(:, :)
+  integer :: n
+  integer :: shape(n)
+  integer :: lower(n)
+!CHECK: %[[C_0:.*]] = arith.constant 0 : index
+!CHECK: %[[VAL_2:.*]] = fir.shape %[[C_0]], %[[C_0]] : (index, index) -> !fir.shape<2>
+!CHECK: %[[VAL_3:.*]] = fir.embox %[[ARG1:.*]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+!CHECK: fir.store %[[VAL_3]] to %[[VAL_0:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+!CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[ARG_0:.*]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>
+!CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i64>
+!CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>
+!CHECK: %[[C_0:.*]]_0 = arith.constant 0 : index
+!CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_0]]_0 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+!CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<i32>
+!CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index
+!CHECK: %[[C_1:.*]] = arith.constant 1 : index
+!CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[ARG_2]], %[[C_1]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+!CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref<i32>
+!CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i32) -> index
+!CHECK: %[[C_0:.*]]_1 = arith.constant 0 : index
+!CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_0]]_1 : (!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: %[[C_1:.*]]_2 = arith.constant 1 : index
+!CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[ARG_3]], %[[C_1]]_2 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+!CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_16]] : !fir.ref<i32>
+!CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> index
+!CHECK: %[[VAL_19:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_9]], %[[VAL_18]], %[[VAL_12]] : (index, index, index, index) -> !fir.shapeshift<2>
+!CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_6]](%[[VAL_19]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shapeshift<2>
+!CHECK: fir.store %[[VAL_20]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  call c_f_pointer(cptr, fptr, shape, lower)
+end subroutine dynamic_shape_lower_2
diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90
index e2d00536cdacb..8a22175ffe19e 100644
--- a/flang/test/Semantics/c_f_pointer.f90
+++ b/flang/test/Semantics/c_f_pointer.f90
@@ -54,4 +54,12 @@ program test
   call c_f_pointer(scalarC, c2ptr)
   !WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type or kind CHARACTER(KIND=4,LEN=1_8) [-Winteroperability]
   call c_f_pointer(scalarC, unicodePtr)
+
+  !ERROR: SHAPE= argument to C_F_POINTER() may not appear when FPTR= is scalar
+  !ERROR: LOWER= argument to C_F_POINTER() may not appear when FPTR= is scalar
+  call c_f_pointer(scalarC, scalarIntF, [1_8], [0_8])
+  !ERROR: LOWER= argument to C_F_POINTER() must be a rank-one array.
+  call c_f_pointer(scalarC, arrayIntF, shape=[1_8], lower=rankTwoArray)
+  !ERROR: SHAPE= argument to C_F_POINTER() must appear when FPTR= is an array
+  call c_f_pointer(scalarC, arrayIntF, lower=[0])
 end program

Copilot

Pull Request Overview

This PR implements the F2023 extension of the LOWER= argument for the C_F_POINTER intrinsic, allowing users to specify custom lower bounds when converting C pointers to Fortran array pointers. The implementation includes semantic validation, code generation support, and comprehensive test coverage.

Adds semantic validation for the new LOWER= argument with appropriate error checking
Implements code generation logic to handle lower bounds in pointer creation
Updates documentation to reflect the newly supported feature

Reviewed Changes

Copilot reviewed 5 out of 5 changed files in this pull request and generated 2 comments.

Show a summary per file

File	Description
flang/test/Semantics/c_f_pointer.f90	Adds semantic tests for LOWER= argument validation
flang/test/Lower/Intrinsics/c_f_pointer.f90	Adds code generation tests for LOWER= functionality
flang/lib/Optimizer/Builder/IntrinsicCall.cpp	Implements LOWER= argument handling in code generation
flang/lib/Evaluate/intrinsics.cpp	Adds semantic validation for LOWER= argument
flang/docs/F202X.md	Removes C_F_POINTER(LOWER=) from unimplemented features list

Comments suppressed due to low confidence (2)

flang/test/Lower/Intrinsics/c_f_pointer.f90:148

Parameter name 'fpr' in the subroutine signature doesn't match the variable name 'fptr' used in the body. This creates inconsistency and potential confusion.

  real, pointer :: fptr(:, :)

flang/test/Lower/Intrinsics/c_f_pointer.f90:186

Parameter name 'fpr' in the subroutine signature doesn't match the variable name 'fptr' used in the body. This creates inconsistency and potential confusion.

  real, pointer :: fptr(:, :)

flang/test/Lower/Intrinsics/c_f_pointer.f90

flang/lib/Evaluate/intrinsics.cpp

llvmbot · 2025-07-21T18:54:17Z

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

Author: Michael Klemm (mjklemm)

Changes

This PR resolves issue #147819 and adds support for the F2023 extension of the LOWER= argument for C_F_POINTER.

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

5 Files Affected:

(modified) flang/docs/F202X.md (-1)
(modified) flang/lib/Evaluate/intrinsics.cpp (+40-4)
(modified) flang/lib/Optimizer/Builder/IntrinsicCall.cpp (+22-4)
(modified) flang/test/Lower/Intrinsics/c_f_pointer.f90 (+75)
(modified) flang/test/Semantics/c_f_pointer.f90 (+8)

diff --git a/flang/docs/F202X.md b/flang/docs/F202X.md
index 67ea7fd97449a..7504561a64aa6 100644
--- a/flang/docs/F202X.md
+++ b/flang/docs/F202X.md
@@ -268,7 +268,6 @@ Addressing some issues and omissions in intrinsic modules:
  * LOGICAL8/16/32/64 and REAL16
  * IEEE module facilities upgraded to match latest IEEE FP standard
  * C_F_STRPOINTER, F_C_STRING for NUL-terminated strings
- * C_F_POINTER(LOWER=)
 
 #### Intrinsic Procedure Extensions
 
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 9957010684d48..c48dea4b54b3a 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3073,10 +3073,11 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
     ActualArguments &arguments, FoldingContext &context) const {
   characteristics::Procedure::Attrs attrs;
   attrs.set(characteristics::Procedure::Attr::Subroutine);
-  static const char *const keywords[]{"cptr", "fptr", "shape", nullptr};
+  static const char *const keywords[]{
+      "cptr", "fptr", "shape", "lower", nullptr};
   characteristics::DummyArguments dummies;
-  if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) {
-    CHECK(arguments.size() == 3);
+  if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 2)) {
+    CHECK(arguments.size() == 4);
     if (const auto *expr{arguments[0].value().UnwrapExpr()}) {
       // General semantic checks will catch an actual argument that's not
       // scalar.
@@ -3169,11 +3170,30 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
           }
         }
       }
+      if (arguments[3] && fptrRank == 0) {
+        context.messages().Say(arguments[3]->sourceLocation(),
+            "LOWER= argument to C_F_POINTER() may not appear when FPTR= is scalar"_err_en_US);
+      } else if (arguments[3]) {
+        if (const auto *argExpr{arguments[3].value().UnwrapExpr()}) {
+          if (argExpr->Rank() > 1) {
+            context.messages().Say(arguments[3]->sourceLocation(),
+                "LOWER= argument to C_F_POINTER() must be a rank-one array."_err_en_US);
+          } else if (argExpr->Rank() == 1) {
+            if (auto constShape{GetConstantShape(context, *argExpr)}) {
+              if (constShape->At(ConstantSubscripts{1}).ToInt64() != fptrRank) {
+                context.messages().Say(arguments[3]->sourceLocation(),
+                    "LOWER= argument to C_F_POINTER() must have size equal to the rank of FPTR="_err_en_US);
+              }
+            }
+          }
+        }
+      }
     }
   }
   if (dummies.size() == 2) {
+    // Handle SHAPE
     DynamicType shapeType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
-    if (arguments[2]) {
+    if (arguments.size() >=3 && arguments[2]) {
       if (auto type{arguments[2]->GetType()}) {
         if (type->category() == TypeCategory::Integer) {
           shapeType = *type;
@@ -3185,6 +3205,22 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
     shape.intent = common::Intent::In;
     shape.attrs.set(characteristics::DummyDataObject::Attr::Optional);
     dummies.emplace_back("shape"s, std::move(shape));
+
+    // Handle LOWER
+    DynamicType lowerType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
+    if (arguments.size() >= 4 && arguments[3]) {
+      if (auto type{arguments[3]->GetType()}) {
+        if (type->category() == TypeCategory::Integer) {
+          lowerType = *type;
+        }
+      }
+    }
+    characteristics::DummyDataObject lower{
+        characteristics::TypeAndShape{lowerType, 1}};
+    lower.intent = common::Intent::In;
+    lower.attrs.set(characteristics::DummyDataObject::Attr::Optional);
+    dummies.emplace_back("lower"s, std::move(lower));
+
     return SpecificCall{
         SpecificIntrinsic{"__builtin_c_f_pointer"s,
             characteristics::Procedure{std::move(dummies), attrs}},
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index d77a656158a37..a99c4cb112c21 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -369,7 +369,8 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genCFPointer,
      {{{"cptr", asValue},
        {"fptr", asInquired},
-       {"shape", asAddr, handleDynamicOptional}}},
+       {"shape", asAddr, handleDynamicOptional},
+       {"lower", asAddr, handleDynamicOptional}}},
      /*isElemental=*/false},
     {"c_f_procpointer",
      &I::genCFProcPointer,
@@ -3403,7 +3404,7 @@ IntrinsicLibrary::genCDevLoc(mlir::Type resultType,
 
 // C_F_POINTER
 void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
-  assert(args.size() == 3);
+  assert(args.size() == 4);
   // Handle CPTR argument
   // Get the value of the C address or the result of a reference to C_LOC.
   mlir::Value cPtr = fir::getBase(args[0]);
@@ -3418,9 +3419,12 @@ void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
     mlir::Value addr =
         builder.createConvert(loc, fPtr->getMemTy(), cPtrAddrVal);
     mlir::SmallVector<mlir::Value> extents;
+    mlir::SmallVector<mlir::Value> lbounds;
     if (box.hasRank()) {
       assert(isStaticallyPresent(args[2]) &&
              "FPTR argument must be an array if SHAPE argument exists");
+
+      // Handle and unpack SHAPE argument
       mlir::Value shape = fir::getBase(args[2]);
       int arrayRank = box.rank();
       mlir::Type shapeElementType =
@@ -3433,17 +3437,31 @@ void IntrinsicLibrary::genCFPointer(llvm::ArrayRef<fir::ExtendedValue> args) {
         mlir::Value load = builder.create<fir::LoadOp>(loc, var);
         extents.push_back(builder.createConvert(loc, idxType, load));
       }
+
+      // Handle and unpack LOWER argument if present
+      if (isStaticallyPresent(args[3])) {
+        mlir::Value lower = fir::getBase(args[3]);
+        mlir::Type lowerElementType =
+            fir::unwrapSequenceType(fir::unwrapPassByRefType(lower.getType()));
+        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(lowerElementType), lower, index);
+          mlir::Value load = builder.create<fir::LoadOp>(loc, var);
+          lbounds.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::CharArrayBoxValue{addr, len, extents, lbounds};
       return fir::CharBoxValue{addr, len};
     }
     if (box.isDerivedWithLenParameters())
       TODO(loc, "get length parameters of derived type");
     if (box.hasRank())
-      return fir::ArrayBoxValue{addr, extents};
+      return fir::ArrayBoxValue{addr, extents, lbounds};
     return addr;
   };
 
diff --git a/flang/test/Lower/Intrinsics/c_f_pointer.f90 b/flang/test/Lower/Intrinsics/c_f_pointer.f90
index 67817e39d5c2b..f41d5e471f540 100644
--- a/flang/test/Lower/Intrinsics/c_f_pointer.f90
+++ b/flang/test/Lower/Intrinsics/c_f_pointer.f90
@@ -140,3 +140,78 @@ subroutine dynamic_shape_size_2(cptr, fptr, shape, n)
 ! CHECK:         %[[VAL_16:.*]] = fir.shape %[[VAL_11]], %[[VAL_15]] : (index, index) -> !fir.shape<2>
   call c_f_pointer(cptr, fptr, shape)
 end subroutine
+
+! CHECK-LABEL: func.func @_QPdynamic_shape_lower(
+subroutine dynamic_shape_lower(cptr, fpr, shape, lower)
+  use iso_c_binding
+  type(c_ptr)  :: cptr
+  real, pointer :: fptr(:, :)
+  integer :: n
+  integer :: shape(:)
+  integer :: lower(:)
+! CHECK: %[[C_0:.*]] = arith.constant 0 : index
+! CHECK: %[[VAL_2:.*]] = fir.shape %[[C_0]], %[[C_0]] : (index, index) -> !fir.shape<2>
+! CHECK: %[[VAL_3:.*]] = fir.embox %[[VAL_1:.*]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK: fir.store %[[VAL_3]] to %[[VAL_0:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+! CHECK: %[[VAL_4:.*]] = fir.alloca i32 {bindc_name = "n", uniq_name = "_QFdynamic_shape_lowerEn"}
+! CHECK: %[[VAL_5:.*]] = fir.coordinate_of %[[ARG_0:.*]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>
+! CHECK: %[[VAL_6:.*]] = fir.load %[[VAL_5]] : !fir.ref<i64>
+! CHECK: %[[VAL_7:.*]] = fir.convert %[[VAL_6]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>
+! CHECK: %[[C_0:.*]]_0 = arith.constant 0 : index
+! CHECK: %[[VAL_8:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_0]]_0 : (!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: %[[C_1:.*]] = arith.constant 1 : index
+! CHECK: %[[VAL_11:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_1]] : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_12:.*]] = fir.load %[[VAL_11]] : !fir.ref<i32>
+! CHECK: %[[VAL_13:.*]] = fir.convert %[[VAL_12]] : (i32) -> index
+! CHECK: %[[C_0:.*]]_1 = arith.constant 0 : index
+! CHECK: %[[VAL_14:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_0]]_1 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_15:.*]] = fir.load %[[VAL_14]] : !fir.ref<i32>
+! CHECK: %[[VAL_16:.*]] = fir.convert %[[VAL_15]] : (i32) -> index
+! CHECK: %[[C_1:.*]]_2 = arith.constant 1 : index
+! CHECK: %[[VAL_17:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_1]]_2 : (!fir.box<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+! CHECK: %[[VAL_18:.*]] = fir.load %[[VAL_17]] : !fir.ref<i32>
+! CHECK: %[[VAL_19:.*]] = fir.convert %[[VAL_18]] : (i32) -> index
+! CHECK: %[[VAL_20:.*]] = fir.shape_shift %[[VAL_16]], %[[VAL_10]], %[[VAL_19]], %[[VAL_13]] : (index, index, index, index) -> !fir.shapeshift<2>
+! CHECK: %[[VAL_21:.*]] = fir.embox %[[VAL_7]](%[[VAL_20]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shapeshift<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+! CHECK: fir.store %[[VAL_21:.*]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  call c_f_pointer(cptr, fptr, shape, lower)
+end subroutine dynamic_shape_lower
+
+! CHECK-LABEL: func.func @_QPdynamic_shape_lower_2(
+subroutine dynamic_shape_lower_2(cptr, fpr, shape, lower, n)
+  use iso_c_binding
+  type(c_ptr)  :: cptr
+  real, pointer :: fptr(:, :)
+  integer :: n
+  integer :: shape(n)
+  integer :: lower(n)
+!CHECK: %[[C_0:.*]] = arith.constant 0 : index
+!CHECK: %[[VAL_2:.*]] = fir.shape %[[C_0]], %[[C_0]] : (index, index) -> !fir.shape<2>
+!CHECK: %[[VAL_3:.*]] = fir.embox %[[ARG1:.*]](%[[VAL_2]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shape<2>) -> !fir.box<!fir.ptr<!fir.array<?x?xf32>>>
+!CHECK: fir.store %[[VAL_3]] to %[[VAL_0:.*]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+!CHECK: %[[VAL_4:.*]] = fir.coordinate_of %[[ARG_0:.*]], __address : (!fir.ref<!fir.type<_QM__fortran_builtinsT__builtin_c_ptr{__address:i64}>>) -> !fir.ref<i64>
+!CHECK: %[[VAL_5:.*]] = fir.load %[[VAL_4]] : !fir.ref<i64>
+!CHECK: %[[VAL_6:.*]] = fir.convert %[[VAL_5]] : (i64) -> !fir.ptr<!fir.array<?x?xf32>>
+!CHECK: %[[C_0:.*]]_0 = arith.constant 0 : index
+!CHECK: %[[VAL_7:.*]] = fir.coordinate_of %[[ARG_2:.*]], %[[C_0]]_0 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+!CHECK: %[[VAL_8:.*]] = fir.load %[[VAL_7]] : !fir.ref<i32>
+!CHECK: %[[VAL_9:.*]] = fir.convert %[[VAL_8]] : (i32) -> index
+!CHECK: %[[C_1:.*]] = arith.constant 1 : index
+!CHECK: %[[VAL_10:.*]] = fir.coordinate_of %[[ARG_2]], %[[C_1]] : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+!CHECK: %[[VAL_11:.*]] = fir.load %[[VAL_10]] : !fir.ref<i32>
+!CHECK: %[[VAL_12:.*]] = fir.convert %[[VAL_11]] : (i32) -> index
+!CHECK: %[[C_0:.*]]_1 = arith.constant 0 : index
+!CHECK: %[[VAL_13:.*]] = fir.coordinate_of %[[ARG_3:.*]], %[[C_0]]_1 : (!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: %[[C_1:.*]]_2 = arith.constant 1 : index
+!CHECK: %[[VAL_16:.*]] = fir.coordinate_of %[[ARG_3]], %[[C_1]]_2 : (!fir.ref<!fir.array<?xi32>>, index) -> !fir.ref<i32>
+!CHECK: %[[VAL_17:.*]] = fir.load %[[VAL_16]] : !fir.ref<i32>
+!CHECK: %[[VAL_18:.*]] = fir.convert %[[VAL_17]] : (i32) -> index
+!CHECK: %[[VAL_19:.*]] = fir.shape_shift %[[VAL_15]], %[[VAL_9]], %[[VAL_18]], %[[VAL_12]] : (index, index, index, index) -> !fir.shapeshift<2>
+!CHECK: %[[VAL_20:.*]] = fir.embox %[[VAL_6]](%[[VAL_19]]) : (!fir.ptr<!fir.array<?x?xf32>>, !fir.shapeshift<2>
+!CHECK: fir.store %[[VAL_20]] to %[[VAL_0]] : !fir.ref<!fir.box<!fir.ptr<!fir.array<?x?xf32>>>>
+  call c_f_pointer(cptr, fptr, shape, lower)
+end subroutine dynamic_shape_lower_2
diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90
index e2d00536cdacb..8a22175ffe19e 100644
--- a/flang/test/Semantics/c_f_pointer.f90
+++ b/flang/test/Semantics/c_f_pointer.f90
@@ -54,4 +54,12 @@ program test
   call c_f_pointer(scalarC, c2ptr)
   !WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type or kind CHARACTER(KIND=4,LEN=1_8) [-Winteroperability]
   call c_f_pointer(scalarC, unicodePtr)
+
+  !ERROR: SHAPE= argument to C_F_POINTER() may not appear when FPTR= is scalar
+  !ERROR: LOWER= argument to C_F_POINTER() may not appear when FPTR= is scalar
+  call c_f_pointer(scalarC, scalarIntF, [1_8], [0_8])
+  !ERROR: LOWER= argument to C_F_POINTER() must be a rank-one array.
+  call c_f_pointer(scalarC, arrayIntF, shape=[1_8], lower=rankTwoArray)
+  !ERROR: SHAPE= argument to C_F_POINTER() must appear when FPTR= is an array
+  call c_f_pointer(scalarC, arrayIntF, lower=[0])
 end program

github-actions · 2025-07-21T18:56:16Z

✅ With the latest revision this PR passed the C/C++ code formatter.

Meinersbur

LGTM

Consider adding a line to https://github.com/llvm/llvm-project/blob/main/flang/docs/ReleaseNotes.md

…m#149870) This PR resolves issue llvm#147819 and adds support for the F2023 extension of the `LOWER=` argument for `C_F_POINTER`.

- Trig functions: done with various earlier commits like #149343. - c_f_pointer: #149870.

mjklemm added 3 commits July 21, 2025 18:53

[Flang] Implement LOWER argument for C_F_POINTER

aaa6fbb

This PR adds support for the optional LOWER argument for C_F_POINTER (Fortran 2023, 18.2.3.3)

Add LOWER= to semantics test

3e5f80c

Add LOWER= to lowering test

117fe8e

mjklemm requested review from jeanPerier, klausler, kparzysz and Copilot July 21, 2025 18:53

mjklemm self-assigned this Jul 21, 2025

llvmbot added flang Flang issues not falling into any other category flang:fir-hlfir flang:semantics labels Jul 21, 2025

mjklemm changed the title ~~[Flang] Implement LOWER argument for C_F_POINTER~~ [Flang] Implement LOWER= argument for C_F_POINTER (Fortran 2023) Jul 21, 2025

Copilot AI reviewed Jul 21, 2025

View reviewed changes

flang/test/Lower/Intrinsics/c_f_pointer.f90 Outdated Show resolved Hide resolved

flang/lib/Evaluate/intrinsics.cpp Outdated Show resolved Hide resolved

mjklemm added 2 commits July 21, 2025 20:56

Fix code formatting

f9d3c1b

Follow Copilot's recommendation

b7c520d

mjklemm requested review from ergawy and Meinersbur July 21, 2025 19:06

klausler removed their request for review July 22, 2025 14:45

Meinersbur approved these changes Jul 23, 2025

View reviewed changes

Add entry in release notes

19746a3

mjklemm requested review from kiranchandramohan and tblah July 23, 2025 12:52

kparzysz approved these changes Jul 25, 2025

View reviewed changes

mjklemm added 2 commits July 25, 2025 20:54

Merge branch 'main' into issue_147819

b62e283

Merge branch 'main' into issue_147819

bb3f8dd

mjklemm merged commit f834b0c into llvm:main Jul 25, 2025
10 checks passed

This was referenced Jul 29, 2025

Support LOWER optional argument in C_F_POINTER interface #147819

Closed

[flang][doc] Update some F2023 status. #151165

Merged

c8ef added a commit that referenced this pull request Jul 31, 2025

[flang][doc] Update some F2023 status. (#151165)

b00d4f2

- Trig functions: done with various earlier commits like #149343. - c_f_pointer: #149870.

Provide feedback

Saved searches

Use saved searches to filter your results more quickly

Uh oh!

[Flang] Implement LOWER= argument for C_F_POINTER (Fortran 2023) #149870

[Flang] Implement LOWER= argument for C_F_POINTER (Fortran 2023) #149870

Uh oh!

mjklemm commented Jul 21, 2025

Uh oh!

llvmbot commented Jul 21, 2025

Uh oh!

Copilot AI left a comment

Uh oh!

Uh oh!

Uh oh!

llvmbot commented Jul 21, 2025

Uh oh!

github-actions bot commented Jul 21, 2025 •

edited

Loading

Uh oh!

Meinersbur left a comment

Uh oh!

Uh oh!

Uh oh!

[Flang] Implement LOWER= argument for C_F_POINTER (Fortran 2023) #149870

[Flang] Implement LOWER= argument for C_F_POINTER (Fortran 2023) #149870

Uh oh!

Conversation

mjklemm commented Jul 21, 2025

Uh oh!

llvmbot commented Jul 21, 2025

Uh oh!

Copilot AI left a comment

Choose a reason for hiding this comment

Pull Request Overview

Reviewed Changes

Uh oh!

Uh oh!

Uh oh!

llvmbot commented Jul 21, 2025

Uh oh!

github-actions bot commented Jul 21, 2025 • edited Loading Uh oh! There was an error while loading. Please reload this page.

Uh oh!

Uh oh!

Meinersbur left a comment

Choose a reason for hiding this comment

Uh oh!

Uh oh!

Uh oh!

github-actions bot commented Jul 21, 2025 •

edited

Loading