Skip to content

Commit 2bc30f3

Browse files
authored
[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 #115012.
1 parent b3026ba commit 2bc30f3

File tree

2 files changed

+11
-10
lines changed

2 files changed

+11
-10
lines changed

flang/lib/Evaluate/intrinsics.cpp

Lines changed: 10 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -2849,15 +2849,16 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
28492849
"FPTR= argument to C_F_POINTER() may not have a deferred type parameter"_err_en_US);
28502850
} else if (type->category() == TypeCategory::Derived) {
28512851
if (context.languageFeatures().ShouldWarn(
2852-
common::UsageWarning::Interoperability)) {
2853-
if (type->IsUnlimitedPolymorphic()) {
2854-
context.messages().Say(common::UsageWarning::Interoperability, at,
2855-
"FPTR= argument to C_F_POINTER() should not be unlimited polymorphic"_warn_en_US);
2856-
} else if (!type->GetDerivedTypeSpec().typeSymbol().attrs().test(
2857-
semantics::Attr::BIND_C)) {
2858-
context.messages().Say(common::UsageWarning::Interoperability, at,
2859-
"FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_warn_en_US);
2860-
}
2852+
common::UsageWarning::Interoperability) &&
2853+
type->IsUnlimitedPolymorphic()) {
2854+
context.messages().Say(common::UsageWarning::Interoperability, at,
2855+
"FPTR= argument to C_F_POINTER() should not be unlimited polymorphic"_warn_en_US);
2856+
} else if (!type->GetDerivedTypeSpec().typeSymbol().attrs().test(
2857+
semantics::Attr::BIND_C) &&
2858+
context.languageFeatures().ShouldWarn(
2859+
common::UsageWarning::Portability)) {
2860+
context.messages().Say(common::UsageWarning::Portability, at,
2861+
"FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)"_port_en_US);
28612862
}
28622863
} else if (!IsInteroperableIntrinsicType(
28632864
*type, &context.languageFeatures())

flang/test/Semantics/c_f_pointer.f90

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ program test
4747
call c_f_pointer(scalarC, multiDimIntF, shape=rankTwoArray)
4848
!WARNING: FPTR= argument to C_F_POINTER() should not be unlimited polymorphic
4949
call c_f_pointer(scalarC, unlimited)
50-
!WARNING: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)
50+
!PORTABILITY: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C)
5151
call c_f_pointer(scalarC, notBindC)
5252
!WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable character length CHARACTER(KIND=1,LEN=2_8)
5353
call c_f_pointer(scalarC, c2ptr)

0 commit comments

Comments
 (0)