[flang-commits] [flang] 5a9d684 - [flang] Split interoperability warnings, disable some by default (#111922)
via flang-commits
flang-commits at lists.llvm.org
Tue Oct 15 14:20:51 PDT 2024
Author: Peter Klausler
Date: 2024-10-15T14:20:48-07:00
New Revision: 5a9d6841ecaf7863809a8e2f67af55a45f374d36
URL: https://github.com/llvm/llvm-project/commit/5a9d6841ecaf7863809a8e2f67af55a45f374d36
DIFF: https://github.com/llvm/llvm-project/commit/5a9d6841ecaf7863809a8e2f67af55a45f374d36.diff
LOG: [flang] Split interoperability warnings, disable some by default (#111922)
Type interoperability warnings current issue for intrinsic types when
their type, kind, or length do not meet the requirements for C
interoperability. This turns out to be too noisy for the case of
one-byte characters with lengths other than one when creating C pointers
from C_LOC or C_F_POINTER -- it is not uncommon for programs to use
pointers to longer character objects.
So split the interoperability warning so that the case of a known bad
character length for an otherwise interoperable type is controlled by
its own UsageWarning enumerator, and leave that usage warning off by
default. This will better fit expectations in the default case while
still showing a warning under -pedantic.
Added:
Modified:
flang/include/flang/Common/Fortran-features.h
flang/lib/Common/Fortran-features.cpp
flang/lib/Evaluate/intrinsics.cpp
flang/test/Semantics/c_f_pointer.f90
flang/test/Semantics/c_loc01.f90
Removed:
################################################################################
diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h
index 3942a792628645..e021df13fe772a 100644
--- a/flang/include/flang/Common/Fortran-features.h
+++ b/flang/include/flang/Common/Fortran-features.h
@@ -63,9 +63,9 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable,
F202XAllocatableBreakingChange, OptionalMustBePresent, CommonBlockPadding,
LogicalVsCBool, BindCCharLength, ProcDummyArgShapes, ExternalNameConflict,
FoldingException, FoldingAvoidsRuntimeCrash, FoldingValueChecks,
- FoldingFailure, FoldingLimit, Interoperability, Bounds, Preprocessing,
- Scanning, OpenAccUsage, ProcPointerCompatibility, VoidMold,
- KnownBadImplicitInterface, EmptyCase, CaseOverflow, CUDAUsage,
+ FoldingFailure, FoldingLimit, Interoperability, CharacterInteroperability,
+ Bounds, Preprocessing, Scanning, OpenAccUsage, ProcPointerCompatibility,
+ VoidMold, KnownBadImplicitInterface, EmptyCase, CaseOverflow, CUDAUsage,
IgnoreTKRUsage, ExternalInterfaceMismatch, DefinedOperatorArgs, Final,
ZeroDoStep, UnusedForallIndex, OpenMPUsage, ModuleFile, DataLength,
IgnoredDirective, HomonymousSpecific, HomonymousResult,
diff --git a/flang/lib/Common/Fortran-features.cpp b/flang/lib/Common/Fortran-features.cpp
index 59f570e6ab6e93..a53f32d74dc37d 100644
--- a/flang/lib/Common/Fortran-features.cpp
+++ b/flang/lib/Common/Fortran-features.cpp
@@ -48,6 +48,7 @@ LanguageFeatureControl::LanguageFeatureControl() {
warnUsage_.set(UsageWarning::FoldingFailure);
warnUsage_.set(UsageWarning::FoldingLimit);
warnUsage_.set(UsageWarning::Interoperability);
+ // CharacterInteroperability warnings about length are off by default
warnUsage_.set(UsageWarning::Bounds);
warnUsage_.set(UsageWarning::Preprocessing);
warnUsage_.set(UsageWarning::Scanning);
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 1f48fc21662ebb..4271faa0db12bf 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2861,12 +2861,22 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
}
} else if (!IsInteroperableIntrinsicType(
*type, &context.languageFeatures())
- .value_or(true) &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::Interoperability)) {
- context.messages().Say(common::UsageWarning::Interoperability, at,
- "FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type %s"_warn_en_US,
- type->AsFortran());
+ .value_or(true)) {
+ if (type->category() == TypeCategory::Character &&
+ type->kind() == 1) {
+ if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::CharacterInteroperability)) {
+ context.messages().Say(
+ 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 if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::Interoperability)) {
+ context.messages().Say(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,
@@ -2963,12 +2973,23 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
context.messages().Say(arguments[0]->sourceLocation(),
"C_LOC() argument may not be zero-length character"_err_en_US);
} else if (typeAndShape->type().category() != TypeCategory::Derived &&
- !IsInteroperableIntrinsicType(typeAndShape->type()).value_or(true) &&
- context.languageFeatures().ShouldWarn(
- common::UsageWarning::Interoperability)) {
- context.messages().Say(common::UsageWarning::Interoperability,
- arguments[0]->sourceLocation(),
- "C_LOC() argument has non-interoperable intrinsic type, kind, or length"_warn_en_US);
+ !IsInteroperableIntrinsicType(typeAndShape->type()).value_or(true)) {
+ if (typeAndShape->type().category() == TypeCategory::Character &&
+ typeAndShape->type().kind() == 1) {
+ // Default character kind, but length is not known to be 1
+ if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::CharacterInteroperability)) {
+ context.messages().Say(
+ common::UsageWarning::CharacterInteroperability,
+ arguments[0]->sourceLocation(),
+ "C_LOC() argument has non-interoperable character length"_warn_en_US);
+ }
+ } else if (context.languageFeatures().ShouldWarn(
+ common::UsageWarning::Interoperability)) {
+ context.messages().Say(common::UsageWarning::Interoperability,
+ arguments[0]->sourceLocation(),
+ "C_LOC() argument has non-interoperable intrinsic type or kind"_warn_en_US);
+ }
}
characteristics::DummyDataObject ddo{std::move(*typeAndShape)};
diff --git a/flang/test/Semantics/c_f_pointer.f90 b/flang/test/Semantics/c_f_pointer.f90
index c2529201ee2659..0cd0161b1fb006 100644
--- a/flang/test/Semantics/c_f_pointer.f90
+++ b/flang/test/Semantics/c_f_pointer.f90
@@ -18,6 +18,7 @@ program test
end type
type(notBindCType), pointer :: notBindC
character(2), pointer :: c2ptr
+ character(1,4), pointer :: unicodePtr
rankTwoArray = reshape([1, 2, 3, 4], shape(rankTwoArray))
call c_f_pointer(scalarC, scalarIntF) ! ok
call c_f_pointer(scalarC, arrayIntF, [1_8]) ! ok
@@ -48,6 +49,8 @@ program test
call c_f_pointer(scalarC, unlimited)
!WARNING: 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 intrinsic type CHARACTER(KIND=1,LEN=2_8)
+ !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)
+ !WARNING: FPTR= argument to C_F_POINTER() should not have the non-interoperable intrinsic type or kind CHARACTER(KIND=4,LEN=1_8)
+ call c_f_pointer(scalarC, unicodePtr)
end program
diff --git a/flang/test/Semantics/c_loc01.f90 b/flang/test/Semantics/c_loc01.f90
index 9155ff4f47354d..abae1e263e2e21 100644
--- a/flang/test/Semantics/c_loc01.f90
+++ b/flang/test/Semantics/c_loc01.f90
@@ -21,6 +21,7 @@ subroutine test(assumedType, poly, nclen, n)
type(hasLen(*)), target :: nclen
integer, intent(in) :: n
character(2), target :: ch
+ character(1,4), target :: unicode
real :: arr1(purefun1(c_loc(targ))) ! ok
real :: arr2(purefun2(c_funloc(subr))) ! ok
character(:), allocatable, target :: deferred
@@ -40,8 +41,10 @@ subroutine test(assumedType, poly, nclen, n)
cp = c_loc(nclen)
!ERROR: C_LOC() argument may not be zero-length character
cp = c_loc(ch(2:1))
- !WARNING: C_LOC() argument has non-interoperable intrinsic type, kind, or length
+ !WARNING: C_LOC() argument has non-interoperable character length
cp = c_loc(ch)
+ !WARNING: C_LOC() argument has non-interoperable intrinsic type or kind
+ cp = c_loc(unicode)
cp = c_loc(ch(1:1)) ! ok
cp = c_loc(deferred) ! ok
cp = c_loc(p2ch) ! ok
More information about the flang-commits
mailing list