[flang-commits] [flang] [flang] Silence over-eager warning about interoperable character length (PR #97353)
via flang-commits
flang-commits at lists.llvm.org
Mon Jul 1 14:38:50 PDT 2024
llvmbot wrote:
<!--LLVM PR SUMMARY COMMENT-->
@llvm/pr-subscribers-flang-semantics
Author: Peter Klausler (klausler)
<details>
<summary>Changes</summary>
Make the results of the two IsInteroperableIntrinsicType() utility routines a tri-state std::optional<bool> so that cases where the character length is simply unknown can be distinguished from those cases where the length is known and not acceptable. Use this distinction to not emit a confusing warning about interoperability with C_LOC() arguments when the length is unknown and might well be acceptable during execution.
---
Full diff: https://github.com/llvm/llvm-project/pull/97353.diff
7 Files Affected:
- (modified) flang/include/flang/Evaluate/type.h (+2-1)
- (modified) flang/include/flang/Semantics/type.h (+1-1)
- (modified) flang/lib/Evaluate/intrinsics.cpp (+15-13)
- (modified) flang/lib/Evaluate/type.cpp (+10-3)
- (modified) flang/lib/Semantics/check-declarations.cpp (+4-2)
- (modified) flang/lib/Semantics/type.cpp (+6-3)
- (modified) flang/test/Semantics/c_loc01.f90 (+7-2)
``````````diff
diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index de19e3d04dea8..16c2b319ff1de 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -485,7 +485,8 @@ int SelectedCharKind(const std::string &, int defaultKind);
std::optional<DynamicType> ComparisonType(
const DynamicType &, const DynamicType &);
-bool IsInteroperableIntrinsicType(const DynamicType &,
+// Returns nullopt for deferred, assumed, and non-constant lengths.
+std::optional<bool> IsInteroperableIntrinsicType(const DynamicType &,
const common::LanguageFeatureControl * = nullptr,
bool checkCharLength = true);
bool IsCUDAIntrinsicType(const DynamicType &);
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 5520b02e6790d..04f8b11e992a0 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -459,7 +459,7 @@ inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const {
return const_cast<DeclTypeSpec *>(this)->AsDerived();
}
-bool IsInteroperableIntrinsicType(
+std::optional<bool> IsInteroperableIntrinsicType(
const DeclTypeSpec &, const common::LanguageFeatureControl &);
} // namespace Fortran::semantics
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 80752d02b5baf..8d1f0121925ea 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2829,7 +2829,8 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
}
}
} else if (!IsInteroperableIntrinsicType(
- *type, &context.languageFeatures()) &&
+ *type, &context.languageFeatures())
+ .value_or(true) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::Interoperability)) {
context.messages().Say(at,
@@ -2931,24 +2932,25 @@ 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()) &&
+ !IsInteroperableIntrinsicType(typeAndShape->type()).value_or(true) &&
context.languageFeatures().ShouldWarn(
common::UsageWarning::Interoperability)) {
context.messages().Say(arguments[0]->sourceLocation(),
"C_LOC() argument has non-interoperable intrinsic type, kind, or length"_warn_en_US);
}
- return SpecificCall{SpecificIntrinsic{"__builtin_c_loc"s,
- characteristics::Procedure{
- characteristics::FunctionResult{
- DynamicType{GetBuiltinDerivedType(
- builtinsScope_, "__builtin_c_ptr")}},
- characteristics::DummyArguments{
- characteristics::DummyArgument{"x"s,
- characteristics::DummyDataObject{
- std::move(*typeAndShape)}}},
- characteristics::Procedure::Attrs{
- characteristics::Procedure::Attr::Pure}}},
+ characteristics::DummyDataObject ddo{std::move(*typeAndShape)};
+ ddo.intent = common::Intent::In;
+ return SpecificCall{
+ SpecificIntrinsic{"__builtin_c_loc"s,
+ characteristics::Procedure{
+ characteristics::FunctionResult{
+ DynamicType{GetBuiltinDerivedType(
+ builtinsScope_, "__builtin_c_ptr")}},
+ characteristics::DummyArguments{
+ characteristics::DummyArgument{"x"s, std::move(ddo)}},
+ characteristics::Procedure::Attrs{
+ characteristics::Procedure::Attr::Pure}}},
std::move(arguments)};
}
}
diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp
index ee1e5b398d9b0..463ac01da0e29 100644
--- a/flang/lib/Evaluate/type.cpp
+++ b/flang/lib/Evaluate/type.cpp
@@ -807,7 +807,7 @@ std::optional<DynamicType> ComparisonType(
}
}
-bool IsInteroperableIntrinsicType(const DynamicType &type,
+std::optional<bool> IsInteroperableIntrinsicType(const DynamicType &type,
const common::LanguageFeatureControl *features, bool checkCharLength) {
switch (type.category()) {
case TypeCategory::Integer:
@@ -819,10 +819,17 @@ bool IsInteroperableIntrinsicType(const DynamicType &type,
case TypeCategory::Logical:
return type.kind() == 1; // C_BOOL
case TypeCategory::Character:
- if (checkCharLength && type.knownLength().value_or(0) != 1) {
+ if (type.kind() != 1) { // C_CHAR
return false;
+ } else if (checkCharLength) {
+ if (type.knownLength()) {
+ return *type.knownLength() == 1;
+ } else {
+ return std::nullopt;
+ }
+ } else {
+ return true;
}
- return type.kind() == 1 /* C_CHAR */;
default:
// Derived types are tested in Semantics/check-declarations.cpp
return false;
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index dae4050279200..2d324d1883a19 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -2982,7 +2982,8 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
msgs.Annex(std::move(bad));
}
} else if (!IsInteroperableIntrinsicType(
- *type, context_.languageFeatures())) {
+ *type, context_.languageFeatures())
+ .value_or(false)) {
auto maybeDyType{evaluate::DynamicType::From(*type)};
if (type->category() == DeclTypeSpec::Logical) {
if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool)) {
@@ -3084,7 +3085,8 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
type->characterTypeSpec().length().isDeferred()) {
// ok; F'2023 18.3.7 p2(6)
} else if (derived ||
- IsInteroperableIntrinsicType(*type, context_.languageFeatures())) {
+ IsInteroperableIntrinsicType(*type, context_.languageFeatures())
+ .value_or(false)) {
// F'2023 18.3.7 p2(4,5)
} else if (type->category() == DeclTypeSpec::Logical) {
if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool) &&
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index 44e49673300bf..ed2474377173f 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -891,10 +891,13 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) {
return o << x.AsFortran();
}
-bool IsInteroperableIntrinsicType(
+std::optional<bool> IsInteroperableIntrinsicType(
const DeclTypeSpec &type, const common::LanguageFeatureControl &features) {
- auto dyType{evaluate::DynamicType::From(type)};
- return dyType && IsInteroperableIntrinsicType(*dyType, &features);
+ if (auto dyType{evaluate::DynamicType::From(type)}) {
+ return IsInteroperableIntrinsicType(*dyType, &features);
+ } else {
+ return std::nullopt;
+ }
}
} // namespace Fortran::semantics
diff --git a/flang/test/Semantics/c_loc01.f90 b/flang/test/Semantics/c_loc01.f90
index 83b88d2ebd4b0..9155ff4f47354 100644
--- a/flang/test/Semantics/c_loc01.f90
+++ b/flang/test/Semantics/c_loc01.f90
@@ -8,7 +8,7 @@ module m
contains
subroutine subr
end
- subroutine test(assumedType, poly, nclen)
+ subroutine test(assumedType, poly, nclen, n)
type(*), target :: assumedType
class(*), target :: poly
type(c_ptr) cp
@@ -19,9 +19,12 @@ subroutine test(assumedType, poly, nclen)
real, target :: arr(3)
type(hasLen(1)), target :: clen
type(hasLen(*)), target :: nclen
+ integer, intent(in) :: n
character(2), target :: ch
real :: arr1(purefun1(c_loc(targ))) ! ok
real :: arr2(purefun2(c_funloc(subr))) ! ok
+ character(:), allocatable, target :: deferred
+ character(n), pointer :: p2ch
!ERROR: C_LOC() argument must be a data pointer or target
cp = c_loc(notATarget)
!ERROR: C_LOC() argument must be a data pointer or target
@@ -39,7 +42,9 @@ subroutine test(assumedType, poly, nclen)
cp = c_loc(ch(2:1))
!WARNING: C_LOC() argument has non-interoperable intrinsic type, kind, or length
cp = c_loc(ch)
- cp = c_loc(ch(1:1)) ! ok)
+ cp = c_loc(ch(1:1)) ! ok
+ cp = c_loc(deferred) ! ok
+ cp = c_loc(p2ch) ! ok
!ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
cp = c_ptr(0)
!ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
``````````
</details>
https://github.com/llvm/llvm-project/pull/97353
More information about the flang-commits
mailing list