[flang-commits] [flang] 2bc30f3 - [flang] Make interoperability warning an off-by-default portability one (#115096)

[via flang-commits]

Author: Peter Klausler
Date: 2024-11-14T14:57:01-08:00
New Revision: 2bc30f37ce7143fd30f21bd232e14aa787f6b08f

URL: https://github.com/llvm/llvm-project/commit/2bc30f37ce7143fd30f21bd232e14aa787f6b08f
DIFF: https://github.com/llvm/llvm-project/commit/2bc30f37ce7143fd30f21bd232e14aa787f6b08f.diff

LOG: [flang] Make interoperability warning an off-by-default portability one (#115096)

The FPTR= argument to the C_F_POINTER intrinsic procedure should be a
pointer with an interoperable type, but isn't required to be, and most
compilers don't mention it. Change the warning from an on-by-default
interoperability warning into an off-by-default portability warning.

Fixes https://github.com/llvm/llvm-project/issues/115012.

Added: 
    

Modified: 
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/c_f_pointer.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index aa44967817722e..a070c67c2bfb82 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2849,15 +2849,16 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
               "FPTR= argument to C_F_POINTER() may not have a deferred type parameter"_err_en_US);
         } else if (type->category() == TypeCategory::Derived) {
           if (context.languageFeatures().ShouldWarn(
-                  common::UsageWarning::Interoperability)) {
-            if (type->IsUnlimitedPolymorphic()) {
-              context.messages().Say(common::UsageWarning::Interoperability, 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(common::UsageWarning::Interoperability, at,
-                  "FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US);
-            }
+                  common::UsageWarning::Interoperability) &&
+              type->IsUnlimitedPolymorphic()) {
+            context.messages().Say(common::UsageWarning::Interoperability, 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.languageFeatures().ShouldWarn(
+                  common::UsageWarning::Portability)) {
+            context.messages().Say(common::UsageWarning::Portability, at,
+                "FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_port_en_US);
           }
         } else if (!IsInteroperableIntrinsicType(
                        *type, &context.languageFeatures())

diff  --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90
index 0cd0161b1fb006..6921438ccded01 100644
--- a/flang/test/Semantics/c_f_pointer.f90
+++ b/flang/test/Semantics/c_f_pointer.f90
@@ -47,7 +47,7 @@ program test
   call c_f_pointer(scalarC, multiDimIntF, shape=rankTwoArray)
   !WARNING: FPTR= argument to C_F_POINTER() should not be unlimited polymorphic
   call c_f_pointer(scalarC, unlimited)
-  !WARNING: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)
+  !PORTABILITY: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)
   call c_f_pointer(scalarC, notBindC)
   !WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable character length CHARACTER(KIND=1,LEN=2_8)
   call c_f_pointer(scalarC, c2ptr)