diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 1de5e6b53ba71..8f4204b1f9afe 100644 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -3139,28 +3139,6 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer( if (type->HasDeferredTypeParameter()) { 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.Warn(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.Warn(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()) - .value_or(true)) { - if (type->category() == TypeCategory::Character && - type->kind() == 1) { - context.Warn(common::UsageWarning::CharacterInteroperability, at, - "FPTR= argument to C_F_POINTER() should not have the non-interoperable character length %s"_warn_en_US, - type->AsFortran()); - } else { - context.Warn(common::UsageWarning::Interoperability, at, - "FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type or kind %s"_warn_en_US, - type->AsFortran()); - } } if (ExtractCoarrayRef(*expr)) { context.messages().Say(at, diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90 index 8a22175ffe19e..29b1127af15bd 100644 --- a/flang/test/Semantics/c_f_pointer.f90 +++ b/flang/test/Semantics/c_f_pointer.f90 @@ -46,13 +46,17 @@ program test call c_f_pointer(scalarC, multiDimIntF, shape=[1_8]) !ERROR: SHAPE= argument to C_F_POINTER() must be a rank-one array. call c_f_pointer(scalarC, multiDimIntF, shape=rankTwoArray) - !WARNING: FPTR= argument to C_F_POINTER() should not be unlimited polymorphic [-Winteroperability] + + !These warnings have been disabled because the C_F_POINTER's restrictions + !are dependent on the source of the CPTR= argument. Each warning here + !might be a false positive for a valid program. + !!WARNING: FPTR= argument to C_F_POINTER() should not be unlimited polymorphic [-Winteroperability] call c_f_pointer(scalarC, unlimited) - !PORTABILITY: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C) [-Wportability] + !!PORTABILITY: FPTR= argument to C_F_POINTER() should not have a derived type that is not BIND(C) [-Wportability] 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) [-Wcharacter-interoperability] + !!WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable character length CHARACTER(KIND=1,LEN=2_8) [-Wcharacter-interoperability] call c_f_pointer(scalarC, c2ptr) - !WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type or kind CHARACTER(KIND=4,LEN=1_8) [-Winteroperability] + !!WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type or kind CHARACTER(KIND=4,LEN=1_8) [-Winteroperability] call c_f_pointer(scalarC, unicodePtr) !ERROR: SHAPE= argument to C_F_POINTER() may not appear when FPTR= is scalar