diff --git a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
index 56642a38cb1c..fd875b682283 100644
--- a/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
+++ b/flang/include/flang/Optimizer/Builder/IntrinsicCall.h
@@ -231,6 +231,7 @@ struct IntrinsicLibrary {
                             llvm::ArrayRef<mlir::Value> args);
   void genCFPointer(llvm::ArrayRef<fir::ExtendedValue>);
   void genCFProcPointer(llvm::ArrayRef<fir::ExtendedValue>);
+  void genCFStrPointer(llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genCFunLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   fir::ExtendedValue genCLoc(mlir::Type, llvm::ArrayRef<fir::ExtendedValue>);
   template <mlir::arith::CmpIPredicate pred>
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 1242e18ba246..4186ca71651d 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2898,6 +2898,8 @@ private:
   SpecificCall HandleNull(ActualArguments &, FoldingContext &) const;
   std::optional<SpecificCall> HandleC_F_Pointer(
       ActualArguments &, FoldingContext &) const;
+  std::optional<SpecificCall> HandleC_F_Strpointer(
+      ActualArguments &, FoldingContext &) const;
   std::optional<SpecificCall> HandleC_Loc(
       ActualArguments &, FoldingContext &) const;
   std::optional<SpecificCall> HandleC_Devloc(
@@ -2940,7 +2942,7 @@ bool IntrinsicProcTable::Implementation::IsIntrinsicSubroutine(
     return true;
   }
   // special cases
-  return name == "__builtin_c_f_pointer";
+  return name == "__builtin_c_f_pointer" || name == "__builtin_c_f_strpointer";
 }
 bool IntrinsicProcTable::Implementation::IsIntrinsic(
     const std::string &name) const {
@@ -3256,6 +3258,206 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
   }
 }
 
+// Subroutine C_F_STRPOINTER from intrinsic module ISO_C_BINDING (18.2.3.5)
+// C_F_STRPOINTER(CSTRARRAY, FSTRPTR [,NCHARS]) or
+// C_F_STRPOINTER(CSTRPTR, FSTRPTR, NCHARS)
+std::optional<SpecificCall>
+IntrinsicProcTable::Implementation::HandleC_F_Strpointer(
+    ActualArguments &arguments, FoldingContext &context) const {
+  characteristics::Procedure::Attrs attrs;
+  attrs.set(characteristics::Procedure::Attr::Subroutine);
+
+  // The first argument can be either CSTRARRAY or CSTRPTR (overloaded).
+  // Assign common internal keyword "cstr" for CheckAndRearrangeArguments.
+  std::optional<std::string> firstArgKeyword;
+  for (auto &arg : arguments) {
+    if (arg && arg->keyword()) {
+      auto kw{arg->keyword()->ToString()};
+      if (kw == "cstrarray" || kw == "cstrptr") {
+        if (!firstArgKeyword) {
+          firstArgKeyword = kw;
+        }
+        static const char cstrKeyword[] = "cstr";
+        arg->set_keyword(
+            parser::CharBlock{cstrKeyword, sizeof(cstrKeyword) - 1});
+      }
+    }
+  }
+
+  static const char *const keywords[]{"cstr", "fstrptr", "nchars", nullptr};
+  characteristics::DummyArguments dummies;
+  if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 1)) {
+    CHECK(arguments.size() == 3);
+    const bool hasNchars{arguments[2].has_value()};
+    const int cCharKind = defaults_.GetDefaultKind(TypeCategory::Character);
+
+    // Check first argument (CSTRARRAY or CSTRPTR) and optional third argument
+    // (NCHARS)
+    if (const auto *expr{arguments[0].value().UnwrapExpr()}) {
+      const auto at{arguments[0]->sourceLocation()};
+      if (const auto type{expr->GetType()}) {
+        if (type->category() == TypeCategory::Derived &&
+            !type->IsPolymorphic() &&
+            (type->GetDerivedTypeSpec().typeSymbol().name() ==
+                    "__builtin_c_ptr" ||
+                type->GetDerivedTypeSpec().typeSymbol().name() ==
+                    "__builtin_c_devptr")) {
+          // First argument is C_PTR (CSTRPTR form)
+          if (firstArgKeyword && *firstArgKeyword != "cstrptr") {
+            context.messages().Say(at,
+                "Keyword CSTRARRAY= cannot be used with a C_PTR argument; use CSTRPTR= instead"_err_en_US);
+          }
+          if (!hasNchars) {
+            context.messages().Say(at,
+                "NCHARS= argument is required when CSTRPTR= appears in C_F_STRPOINTER()"_err_en_US);
+          }
+          characteristics::DummyDataObject cstrptr{
+              characteristics::TypeAndShape{*type}};
+          cstrptr.intent = common::Intent::In;
+          dummies.emplace_back("cstrptr"s, std::move(cstrptr));
+        } else if (type->category() == TypeCategory::Character) {
+          // First argument should be CSTRARRAY - rank-1 character array
+          if (firstArgKeyword && *firstArgKeyword != "cstrarray") {
+            context.messages().Say(at,
+                "Keyword CSTRPTR= cannot be used with a character array argument; use CSTRARRAY= instead"_err_en_US);
+          }
+          if (type->kind() != cCharKind) {
+            context.messages().Say(at,
+                "CSTRARRAY= argument to C_F_STRPOINTER() must be of kind C_CHAR"_err_en_US);
+          }
+          if (expr->Rank() != 1) {
+            context.messages().Say(at,
+                "CSTRARRAY= argument to C_F_STRPOINTER() must be a rank-one array"_err_en_US);
+          }
+          if (const auto len{type->GetCharLength()}) {
+            if (const auto constLen{ToInt64(*len)}) {
+              if (*constLen != 1) {
+                context.messages().Say(at,
+                    "CSTRARRAY= argument to C_F_STRPOINTER() must have length type parameter equal to one"_err_en_US);
+              }
+            }
+          }
+          // Check if CSTRARRAY is assumed-size and NCHARS is absent
+          if (auto shape{GetShape(context, *expr)}) {
+            if (shape->size() == 1) {
+              const auto &extentExpr{(*shape)[0]};
+              const auto extentInt{ToInt64(extentExpr)};
+              if ((!extentInt || *extentInt < 0) && !hasNchars) {
+                context.messages().Say(at,
+                    "NCHARS= argument is required when CSTRARRAY= is assumed-size in C_F_STRPOINTER()"_err_en_US);
+              }
+            }
+          }
+          // Check if NCHARS > size(CSTRARRAY) at compile time
+          if (hasNchars) {
+            if (const auto *ncharsExpr{arguments[2]->UnwrapExpr()}) {
+              if (const auto ncharsVal{ToInt64(*ncharsExpr)}) {
+                if (const auto shape{GetShape(context, *expr)};
+                    shape && shape->size() == 1) {
+                  if (const auto arraySize{ToInt64((*shape)[0])};
+                      arraySize && *arraySize > 0 && *ncharsVal > *arraySize) {
+                    context.messages().Say(arguments[2]->sourceLocation(),
+                        "NCHARS=%jd is greater than the size of CSTRARRAY=%jd in C_F_STRPOINTER()"_err_en_US,
+                        static_cast<std::intmax_t>(*ncharsVal),
+                        static_cast<std::intmax_t>(*arraySize));
+                  }
+                }
+              }
+            }
+          }
+          characteristics::DummyDataObject cstrarray{
+              characteristics::TypeAndShape{*type, 1}};
+          cstrarray.intent = common::Intent::In;
+          cstrarray.attrs.set(characteristics::DummyDataObject::Attr::Target);
+          dummies.emplace_back("cstrarray"s, std::move(cstrarray));
+        } else {
+          context.messages().Say(at,
+              "First argument to C_F_STRPOINTER() must be a C_PTR or a rank-one character array of kind C_CHAR"_err_en_US);
+        }
+      }
+    }
+
+    // Check FSTRPTR argument - must be scalar deferred-length character pointer
+    if (const auto *expr{arguments[1].value().UnwrapExpr()}) {
+      const auto at{arguments[1]->sourceLocation()};
+      if (const auto type{expr->GetType()}) {
+        if (type->category() != TypeCategory::Character) {
+          context.messages().Say(at,
+              "FSTRPTR= argument to C_F_STRPOINTER() must be a character pointer"_err_en_US);
+        } else {
+          if (type->kind() != cCharKind) {
+            context.messages().Say(at,
+                "FSTRPTR= argument to C_F_STRPOINTER() must be of kind C_CHAR"_err_en_US);
+          }
+          if (!type->HasDeferredTypeParameter()) {
+            context.messages().Say(at,
+                "FSTRPTR= argument to C_F_STRPOINTER() must have deferred length"_err_en_US);
+          }
+        }
+        if (ExtractCoarrayRef(*expr)) {
+          context.messages().Say(at,
+              "FSTRPTR= argument to C_F_STRPOINTER() may not be a coindexed object"_err_en_US);
+        }
+        characteristics::DummyDataObject fstrptr{
+            characteristics::TypeAndShape{*type, 0}};
+        fstrptr.intent = common::Intent::Out;
+        fstrptr.attrs.set(characteristics::DummyDataObject::Attr::Pointer);
+        dummies.emplace_back("fstrptr"s, std::move(fstrptr));
+      } else {
+        context.messages().Say(at,
+            "FSTRPTR= argument to C_F_STRPOINTER() must have a type"_err_en_US);
+      }
+    }
+
+    // Check NCHARS argument if present
+    if (hasNchars) {
+      if (const auto *expr{arguments[2].value().UnwrapExpr()}) {
+        const auto at{arguments[2]->sourceLocation()};
+        if (const auto type{expr->GetType()}) {
+          if (type->category() != TypeCategory::Integer) {
+            context.messages().Say(at,
+                "NCHARS= argument to C_F_STRPOINTER() must be an integer"_err_en_US);
+          }
+        }
+        if (expr->Rank() != 0) {
+          context.messages().Say(at,
+              "NCHARS= argument to C_F_STRPOINTER() must be a scalar"_err_en_US);
+        }
+        // Check for negative value if constant
+        if (const auto ncharsVal{ToInt64(*expr)}) {
+          if (*ncharsVal < 0) {
+            context.messages().Say(at,
+                "NCHARS= argument to C_F_STRPOINTER() must be non-negative"_err_en_US);
+          }
+        }
+      }
+    }
+  }
+  if (dummies.size() == 2) {
+    // Add NCHARS dummy
+    DynamicType ncharsType{TypeCategory::Integer, defaults_.sizeIntegerKind()};
+    if (arguments.size() >= 3 && arguments[2]) {
+      if (const auto type{arguments[2]->GetType()}) {
+        if (type->category() == TypeCategory::Integer) {
+          ncharsType = *type;
+        }
+      }
+    }
+    characteristics::DummyDataObject nchars{
+        characteristics::TypeAndShape{ncharsType}};
+    nchars.intent = common::Intent::In;
+    nchars.attrs.set(characteristics::DummyDataObject::Attr::Optional);
+    dummies.emplace_back("nchars"s, std::move(nchars));
+
+    return SpecificCall{
+        SpecificIntrinsic{"__builtin_c_f_strpointer"s,
+            characteristics::Procedure{std::move(dummies), attrs}},
+        std::move(arguments)};
+  } else {
+    return std::nullopt;
+  }
+}
+
 // Function C_LOC(X) from intrinsic module ISO_C_BINDING (18.2.3.6)
 std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
     ActualArguments &arguments, FoldingContext &context) const {
@@ -3538,6 +3740,8 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
   if (call.isSubroutineCall) {
     if (call.name == "__builtin_c_f_pointer") {
       return HandleC_F_Pointer(arguments, context);
+    } else if (call.name == "__builtin_c_f_strpointer") {
+      return HandleC_F_Strpointer(arguments, context);
     } else if (call.name == "random_seed") {
       int optionalCount{0};
       for (const auto &arg : arguments) {
diff --git a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
index bf76a78e7e25..d3c67395a08b 100644
--- a/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
+++ b/flang/lib/Optimizer/Builder/IntrinsicCall.cpp
@@ -193,6 +193,12 @@ static constexpr IntrinsicHandler handlers[]{
      &I::genCFProcPointer,
      {{{"cptr", asValue}, {"fptr", asInquired}}},
      /*isElemental=*/false},
+    {"c_f_strpointer",
+     &I::genCFStrPointer,
+     {{{"cstrptr_or_cstrarray", asValue},
+       {"fstrptr", asInquired},
+       {"nchars", asValue, handleDynamicOptional}}},
+     /*isElemental=*/false},
     {"c_funloc", &I::genCFunLoc, {{{"x", asBox}}}, /*isElemental=*/false},
     {"c_loc", &I::genCLoc, {{{"x", asBox}}}, /*isElemental=*/false},
     {"c_ptr_eq", &I::genCPtrCompare<mlir::arith::CmpIPredicate::eq>},
@@ -3250,6 +3256,99 @@ void IntrinsicLibrary::genCFProcPointer(
   fir::StoreOp::create(builder, loc, cptrBox, fptr);
 }
 
+// C_F_STRPOINTER
+void IntrinsicLibrary::genCFStrPointer(
+    llvm::ArrayRef<fir::ExtendedValue> args) {
+  assert(args.size() == 3);
+
+  mlir::Value cStrAddr;
+  mlir::Value strLen;
+
+  const mlir::Value firstArg = fir::getBase(args[0]);
+  const mlir::Type firstArgType = fir::unwrapRefType(firstArg.getType());
+  const bool isCstrptr = mlir::isa<fir::RecordType>(firstArgType);
+
+  if (isCstrptr) {
+    // CSTRPTR form: Extract address from C_PTR
+    cStrAddr = fir::factory::genCPtrOrCFunptrValue(builder, loc, firstArg);
+
+    assert(isStaticallyPresent(args[2]));
+    mlir::Value nchars = fir::getBase(args[2]);
+    if (fir::isa_ref_type(nchars.getType())) {
+      strLen = fir::LoadOp::create(builder, loc, nchars);
+    } else {
+      strLen = nchars;
+    }
+  } else {
+    // CSTRARRAY form: Get address from CHARACTER array
+    if (const auto boxCharTy =
+            mlir::dyn_cast<fir::BoxCharType>(firstArg.getType())) {
+      const auto charTy = mlir::cast<fir::CharacterType>(boxCharTy.getEleTy());
+      const auto addrTy = builder.getRefType(charTy);
+      auto unboxed = fir::UnboxCharOp::create(
+          builder, loc, mlir::TypeRange{addrTy, builder.getIndexType()},
+          firstArg);
+      cStrAddr = unboxed.getResult(0);
+    } else if (mlir::isa<fir::BoxType>(firstArg.getType())) {
+      cStrAddr = fir::BoxAddrOp::create(builder, loc, firstArg);
+    } else {
+      cStrAddr = firstArg;
+    }
+
+    // Handle optional NCHARS argument
+    if (isStaticallyPresent(args[2])) {
+      mlir::Value nchars = fir::getBase(args[2]);
+      if (fir::isa_ref_type(nchars.getType())) {
+        strLen = fir::LoadOp::create(builder, loc, nchars);
+      } else {
+        strLen = nchars;
+      }
+    } else {
+      const mlir::Type i8PtrTy = builder.getRefType(builder.getIntegerType(8));
+      const mlir::Value strPtr = builder.createConvert(loc, i8PtrTy, cStrAddr);
+
+      const mlir::Type i64Ty = builder.getIntegerType(64);
+      const mlir::FunctionType strlenType =
+          mlir::FunctionType::get(builder.getContext(), {i8PtrTy}, {i64Ty});
+
+      mlir::func::FuncOp strlenFunc = builder.getNamedFunction("strlen");
+      if (!strlenFunc) {
+        strlenFunc = builder.createFunction(loc, "strlen", strlenType);
+        strlenFunc->setAttr(
+            fir::getSymbolAttrName(),
+            mlir::StringAttr::get(builder.getContext(), "strlen"));
+      }
+      auto call = fir::CallOp::create(builder, loc, strlenFunc, {strPtr});
+      strLen = call.getResult(0);
+    }
+  }
+
+  // Handle FSTRPTR (second argument)
+  const auto *fStrPtr = args[1].getBoxOf<fir::MutableBoxValue>();
+  assert(fStrPtr && "FSTRPTR must be a pointer");
+
+  const mlir::Value lenIdx =
+      builder.createConvert(loc, builder.getIndexType(), strLen);
+
+  const mlir::Type charPtrType = fir::PointerType::get(fir::CharacterType::get(
+      builder.getContext(), 1, fir::CharacterType::unknownLen()));
+  const mlir::Value charPtr = builder.createConvert(loc, charPtrType, cStrAddr);
+
+  const fir::CharBoxValue charBox{charPtr, lenIdx};
+  fir::factory::associateMutableBox(builder, loc, *fStrPtr, charBox,
+                                    /*lbounds=*/mlir::ValueRange{});
+
+  // CUDA synchronization if needed
+  if (auto declare = mlir::dyn_cast_or_null<hlfir::DeclareOp>(
+          fStrPtr->getAddr().getDefiningOp()))
+    if (declare.getMemref().getDefiningOp() &&
+        mlir::isa<fir::AddrOfOp>(declare.getMemref().getDefiningOp()))
+      if (cuf::isRegisteredDeviceAttr(declare.getDataAttr()) &&
+          !cuf::isCUDADeviceContext(builder.getRegion()))
+        fir::runtime::cuda::genSyncGlobalDescriptor(builder, loc,
+                                                    declare.getMemref());
+}
+
 // C_FUNLOC
 fir::ExtendedValue
 IntrinsicLibrary::genCFunLoc(mlir::Type resultType,
diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90
index 3f313f8ffbe8..ca9827224151 100644
--- a/flang/module/__fortran_builtins.f90
+++ b/flang/module/__fortran_builtins.f90
@@ -31,6 +31,9 @@ module __fortran_builtins
   intrinsic :: __builtin_f_c_string
   public :: __builtin_f_c_string
 
+  intrinsic :: __builtin_c_f_strpointer
+  public :: __builtin_c_f_strpointer
+
   intrinsic :: __builtin_show_descriptor
   public :: __builtin_show_descriptor
 
diff --git a/flang/module/iso_c_binding.f90 b/flang/module/iso_c_binding.f90
index 9b4a3fe1c34c..a71839b5fdce 100644
--- a/flang/module/iso_c_binding.f90
+++ b/flang/module/iso_c_binding.f90
@@ -15,6 +15,7 @@ module iso_c_binding
     c_funloc => __builtin_c_funloc, &
     c_funptr => __builtin_c_funptr, &
     c_f_pointer => __builtin_c_f_pointer, &
+    c_f_strpointer => __builtin_c_f_strpointer, &
     c_loc => __builtin_c_loc, &
     c_null_funptr => __builtin_c_null_funptr, &
     c_null_ptr => __builtin_c_null_ptr, &
@@ -29,8 +30,8 @@ module iso_c_binding
   ! to be exported by this MODULE.
   private
 
-  public :: c_associated, c_funloc, c_funptr, c_f_pointer, c_loc, &
-    c_null_funptr, c_null_ptr, c_ptr, c_sizeof, f_c_string, &
+  public :: c_associated, c_funloc, c_funptr, c_f_pointer, c_f_strpointer, &
+    c_loc, c_null_funptr, c_null_ptr, c_ptr, c_sizeof, f_c_string, &
     operator(==), operator(/=)
 
   ! Table 18.2 (in clause 18.3.1)
diff --git a/flang/test/Lower/Intrinsics/c_f_strpointer.f90 b/flang/test/Lower/Intrinsics/c_f_strpointer.f90
new file mode 100644
index 000000000000..152533007886
--- /dev/null
+++ b/flang/test/Lower/Intrinsics/c_f_strpointer.f90
@@ -0,0 +1,58 @@
+! RUN: bbc -emit-hlfir %s -o - | FileCheck %s
+! RUN: %flang_fc1 -emit-hlfir %s -o - | FileCheck %s
+
+! Test intrinsic module procedure c_f_strpointer
+
+! CHECK-LABEL: func.func @_QPtest_cstrarray(
+subroutine test_cstrarray(cstrarray, fstrptr)
+  use iso_c_binding
+  character(len=1, kind=c_char), dimension(*), target, intent(in) :: cstrarray
+  character(len=:), pointer, intent(out) :: fstrptr
+  ! CHECK-DAG: %[[CSTRARRAY_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrarrayEcstrarray"}
+  ! CHECK-DAG: %[[FSTRPTR_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrarrayEfstrptr"}
+  ! CHECK: %[[NCHARS:.*]] = arith.constant 100 : i32
+  ! CHECK: %[[NCHARS_IDX:.*]] = fir.convert %[[NCHARS]] : (i32) -> index
+  ! CHECK: %[[PTR:.*]] = fir.convert %[[CSTRARRAY_DECL]]#1 : (!fir.ref<!fir.array<?x!fir.char<1>>>) -> !fir.ptr<!fir.char<1,?>>
+  ! CHECK: %[[BOX:.*]] = fir.embox %[[PTR]] typeparams %[[NCHARS_IDX]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+  ! CHECK: fir.store %[[BOX]] to %[[FSTRPTR_DECL]]#0
+  call c_f_strpointer(cstrarray, fstrptr, 100)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_cstrarray_no_nchars(
+subroutine test_cstrarray_no_nchars(fstrptr)
+  use iso_c_binding
+  character(len=1, kind=c_char), dimension(100), target :: cstrarray
+  character(len=:), pointer, intent(out) :: fstrptr
+  ! CHECK-DAG: %[[CSTRARRAY_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrarray_no_ncharsEcstrarray"}
+  ! CHECK-DAG: %[[FSTRPTR_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrarray_no_ncharsEfstrptr"}
+  ! CHECK: hlfir.assign %{{.*}} to %[[CSTRARRAY_DECL]]#0
+  ! CHECK: %[[I8PTR:.*]] = fir.convert %[[CSTRARRAY_DECL]]#0 : (!fir.ref<!fir.array<100x!fir.char<1>>>) -> !fir.ref<i8>
+  ! CHECK: %[[STRLEN:.*]] = fir.call @strlen(%[[I8PTR]]) {{.*}} : (!fir.ref<i8>) -> i64
+  ! CHECK: %[[STRLEN_IDX:.*]] = fir.convert %[[STRLEN]] : (i64) -> index
+  ! CHECK: %[[PTR:.*]] = fir.convert %[[CSTRARRAY_DECL]]#0 : (!fir.ref<!fir.array<100x!fir.char<1>>>) -> !fir.ptr<!fir.char<1,?>>
+  ! CHECK: %[[BOX:.*]] = fir.embox %[[PTR]] typeparams %[[STRLEN_IDX]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+  ! CHECK: fir.store %[[BOX]] to %[[FSTRPTR_DECL]]#0
+  cstrarray = 'Hello' // c_null_char
+  call c_f_strpointer(cstrarray, fstrptr)
+end subroutine
+
+! CHECK-LABEL: func.func @_QPtest_cstrptr(
+subroutine test_cstrptr(cptr, fstrptr, nchars)
+  use iso_c_binding
+  type(c_ptr), intent(in) :: cptr
+  character(len=:), pointer, intent(out) :: fstrptr
+  integer, intent(in) :: nchars
+  ! CHECK-DAG: %[[CPTR_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrptrEcptr"}
+  ! CHECK-DAG: %[[FSTRPTR_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrptrEfstrptr"}
+  ! CHECK-DAG: %[[NCHARS_DECL:.*]]:2 = hlfir.declare %{{.*}} {{.*}} {{{.*}}uniq_name = "_QFtest_cstrptrEnchars"}
+  ! CHECK: %[[NCHARS_LOAD:.*]] = fir.load %[[NCHARS_DECL]]#0
+  ! CHECK: %[[ADDR_REF:.*]] = fir.coordinate_of %[[CPTR_DECL]]#0, __address
+  ! CHECK: %[[ADDR_VAL:.*]] = fir.load %[[ADDR_REF]] : !fir.ref<i64>
+  ! CHECK: %[[NCHARS_IDX:.*]] = fir.convert %[[NCHARS_LOAD]] : (i32) -> index
+  ! CHECK: %[[PTR:.*]] = fir.convert %[[ADDR_VAL]] : (i64) -> !fir.ptr<!fir.char<1,?>>
+  ! CHECK: %[[BOX:.*]] = fir.embox %[[PTR]] typeparams %[[NCHARS_IDX]] : (!fir.ptr<!fir.char<1,?>>, index) -> !fir.box<!fir.ptr<!fir.char<1,?>>>
+  ! CHECK: fir.store %[[BOX]] to %[[FSTRPTR_DECL]]#0
+  call c_f_strpointer(cptr, fstrptr, nchars)
+end subroutine
+
+end
diff --git a/flang/test/Semantics/c_f_strpointer.f90 b/flang/test/Semantics/c_f_strpointer.f90
new file mode 100644
index 000000000000..94b219f621b6
--- /dev/null
+++ b/flang/test/Semantics/c_f_strpointer.f90
@@ -0,0 +1,74 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+! Enforce C_F_STRPOINTER semantics (18.2.3.5)
+
+program test
+  use iso_c_binding
+  type(c_ptr) :: cptr
+  character(len=:), pointer :: fstrptr
+  character(len=1, kind=c_char), dimension(100), target :: cstrarray
+  character(len=10), pointer :: fstrptr_not_deferred
+  integer :: nchars
+
+  ! Valid calls
+  call c_f_strpointer(cstrarray, fstrptr)  ! ok
+  call c_f_strpointer(cstrarray, fstrptr, 50)  ! ok with NCHARS
+  call c_f_strpointer(cptr, fstrptr, 100)  ! ok with CSTRPTR form
+  call c_f_strpointer(CSTRARRAY=cstrarray, FSTRPTR=fstrptr)  ! ok with CSTRARRAY keyword
+  call c_f_strpointer(CSTRARRAY=cstrarray, FSTRPTR=fstrptr, NCHARS=50)  ! ok with all keywords
+  call c_f_strpointer(CSTRPTR=cptr, FSTRPTR=fstrptr, NCHARS=50)  ! ok with all keywords
+
+  ! Error: CSTRPTR form requires NCHARS
+  !ERROR: NCHARS= argument is required when CSTRPTR= appears in C_F_STRPOINTER()
+  call c_f_strpointer(cptr, fstrptr)
+
+  ! Error: CSTRPTR form requires NCHARS (with explicit keyword)
+  !ERROR: NCHARS= argument is required when CSTRPTR= appears in C_F_STRPOINTER()
+  call c_f_strpointer(CSTRPTR=cptr, FSTRPTR=fstrptr)
+
+  ! Error: Wrong keyword for C_PTR argument
+  !ERROR: Keyword CSTRARRAY= cannot be used with a C_PTR argument; use CSTRPTR= instead
+  call c_f_strpointer(CSTRARRAY=cptr, FSTRPTR=fstrptr, NCHARS=10)
+
+  ! Error: Wrong keyword for character array argument
+  !ERROR: Keyword CSTRPTR= cannot be used with a character array argument; use CSTRARRAY= instead
+  call c_f_strpointer(CSTRPTR=cstrarray, FSTRPTR=fstrptr, NCHARS=50)
+
+  ! Error: FSTRPTR must have deferred length
+  !ERROR: FSTRPTR= argument to C_F_STRPOINTER() must have deferred length
+  call c_f_strpointer(cstrarray, fstrptr_not_deferred)
+
+  ! Error: NCHARS must be non-negative
+  !ERROR: NCHARS= argument to C_F_STRPOINTER() must be non-negative
+  call c_f_strpointer(cstrarray, fstrptr, -5)
+
+  ! Error: NCHARS greater than array size (compile-time check)
+  !ERROR: NCHARS=150 is greater than the size of CSTRARRAY=100 in C_F_STRPOINTER()
+  call c_f_strpointer(cstrarray, fstrptr, 150)
+
+  ! Error: Missing required argument FSTRPTR
+  !ERROR: Dummy argument 'fstrptr=' is absent and not OPTIONAL
+  call c_f_strpointer(cstrarray)
+
+  ! Error: Missing both required arguments
+  !ERROR: Dummy argument 'cstr=' is absent and not OPTIONAL
+  !ERROR: Dummy argument 'fstrptr=' is absent and not OPTIONAL
+  call c_f_strpointer()
+
+  ! Error: Too many arguments
+  !ERROR: Too many actual arguments (4 > 3)
+  call c_f_strpointer(cstrarray, fstrptr, 50, 999)
+
+end program
+
+subroutine test_assumed_size(cstrarray_assumed, fstrptr)
+  use iso_c_binding
+  character(len=1, kind=c_char), dimension(*), target, intent(in) :: cstrarray_assumed
+  character(len=:), pointer :: fstrptr
+
+  ! Error: Assumed-size requires NCHARS
+  !ERROR: NCHARS= argument is required when CSTRARRAY= is assumed-size in C_F_STRPOINTER()
+  call c_f_strpointer(cstrarray_assumed, fstrptr)
+
+  ! Valid: Assumed-size with NCHARS
+  call c_f_strpointer(cstrarray_assumed, fstrptr, 100)
+end subroutine