[flang] Add warnings for non-standard C_F_POINTER() usage (#78332)

There's a few restrictions in the standard on the Fortran pointer
argument (FPTR=) to the intrinsic subroutine C_F_POINTER() that almost
no compilers enforce. Enforce them here with warnings.

1 files changed, 19 insertions, 4 deletions

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d5970..7d2e45d 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2663,13 +2663,28 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
     }
     if (const auto *expr{arguments[1].value().UnwrapExpr()}) {
       int fptrRank{expr->Rank()};
+      auto at{arguments[1]->sourceLocation()};
       if (auto type{expr->GetType()}) {
         if (type->HasDeferredTypeParameter()) {
-          context.messages().Say(arguments[1]->sourceLocation(),
+          context.messages().Say(at,
               "FPTR= argument to C_F_POINTER() may not have a deferred type parameter"_err_en_US);
+        } else if (type->category() == TypeCategory::Derived) {
+          if (type->IsUnlimitedPolymorphic()) {
+            context.messages().Say(at,
+                "FPTR= argument to C_F_POINTER() should not be unlimited polymorphic"_warn_en_US);
+          } else if (!type->GetDerivedTypeSpec().typeSymbol().attrs().test(
+                         semantics::Attr::BIND_C)) {
+            context.messages().Say(at,
+                "FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US);
+          }
+        } else if (!IsInteroperableIntrinsicType(
+                       *type, &context.languageFeatures())) {
+          context.messages().Say(at,
+              "FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type %s"_warn_en_US,
+              type->AsFortran());
         }
         if (ExtractCoarrayRef(*expr)) {
-          context.messages().Say(arguments[1]->sourceLocation(),
+          context.messages().Say(at,
               "FPTR= argument to C_F_POINTER() may not be a coindexed object"_err_en_US);
         }
         characteristics::DummyDataObject fptr{
@@ -2678,8 +2693,8 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
         fptr.attrs.set(characteristics::DummyDataObject::Attr::Pointer);
         dummies.emplace_back("fptr"s, std::move(fptr));
       } else {
-        context.messages().Say(arguments[1]->sourceLocation(),
-            "FPTR= argument to C_F_POINTER() must have a type"_err_en_US);
+        context.messages().Say(
+            at, "FPTR= argument to C_F_POINTER() must have a type"_err_en_US);
       }
       if (arguments[2] && fptrRank == 0) {
         context.messages().Say(arguments[2]->sourceLocation(),