[flang-commits] [flang] [flang] Implement C_F_STRPOINTER (Fortran 2023) (PR #176973)

[Andre Kuhlenschmidt via flang-commits]

================
@@ -3251,6 +3253,184 @@ 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 - we use a generic
+  // keyword since they're mutually exclusive
+  static const char *const keywords[]{
+      "cstrarray", "fstrptr", "nchars", nullptr};
+  characteristics::DummyArguments dummies;
+  if (CheckAndRearrangeArguments(arguments, context.messages(), keywords, 2)) {
+    CHECK(arguments.size() == 3);
+    const bool hasNchars{arguments[2].has_value()};
+
+    // Check first argument (CSTRARRAY or CSTRPTR) and optional third argument
+    // (NCHARS)
+    if (const auto *expr{arguments[0].value().UnwrapExpr()}) {
+      // General semantic checks will catch an actual argument that's not
+      // scalar.
+      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 (!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 (type->kind() != 1) {
----------------
akuhlens wrote:

Please don't hardcode the kind of `C_CHAR` it makes it really hard to see it is correct.

https://github.com/llvm/llvm-project/pull/176973