Skip to content

Commit 60c9033

Browse files
klauslerklausler
authored
[flang] Silence over-eager warning about interoperable character length (#97353)
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.
1 parent 3f30eff commit 60c9033

File tree

7 files changed

+45
-25
lines changed

7 files changed

+45
-25
lines changed

‎flang/include/flang/Evaluate/type.h

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -485,7 +485,8 @@ int SelectedCharKind(const std::string &, int defaultKind);
485485
std::optional<DynamicType> ComparisonType(
486486
const DynamicType &, const DynamicType &);
487487

488-
bool IsInteroperableIntrinsicType(const DynamicType &,
488+
// Returns nullopt for deferred, assumed, and non-constant lengths.
489+
std::optional<bool> IsInteroperableIntrinsicType(const DynamicType &,
489490
const common::LanguageFeatureControl * = nullptr,
490491
bool checkCharLength = true);
491492
bool IsCUDAIntrinsicType(const DynamicType &);

‎flang/include/flang/Semantics/type.h

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -459,7 +459,7 @@ inline const DerivedTypeSpec *DeclTypeSpec::AsDerived() const {
459459
return const_cast<DeclTypeSpec *>(this)->AsDerived();
460460
}
461461

462-
bool IsInteroperableIntrinsicType(
462+
std::optional<bool> IsInteroperableIntrinsicType(
463463
const DeclTypeSpec &, const common::LanguageFeatureControl &);
464464

465465
} // namespace Fortran::semantics

‎flang/lib/Evaluate/intrinsics.cpp

Lines changed: 15 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -2831,7 +2831,8 @@ IntrinsicProcTable::Implementation::HandleC_F_Pointer(
28312831
}
28322832
}
28332833
} else if (!IsInteroperableIntrinsicType(
2834-
*type, &context.languageFeatures()) &&
2834+
*type, &context.languageFeatures())
2835+
.value_or(true) &&
28352836
context.languageFeatures().ShouldWarn(
28362837
common::UsageWarning::Interoperability)) {
28372838
context.messages().Say(at,
@@ -2933,24 +2934,25 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::HandleC_Loc(
29332934
context.messages().Say(arguments[0]->sourceLocation(),
29342935
"C_LOC() argument may not be zero-length character"_err_en_US);
29352936
} else if (typeAndShape->type().category() != TypeCategory::Derived &&
2936-
!IsInteroperableIntrinsicType(typeAndShape->type()) &&
2937+
!IsInteroperableIntrinsicType(typeAndShape->type()).value_or(true) &&
29372938
context.languageFeatures().ShouldWarn(
29382939
common::UsageWarning::Interoperability)) {
29392940
context.messages().Say(arguments[0]->sourceLocation(),
29402941
"C_LOC() argument has non-interoperable intrinsic type, kind, or length"_warn_en_US);
29412942
}
29422943

2943-
return SpecificCall{SpecificIntrinsic{"__builtin_c_loc"s,
2944-
characteristics::Procedure{
2945-
characteristics::FunctionResult{
2946-
DynamicType{GetBuiltinDerivedType(
2947-
builtinsScope_, "__builtin_c_ptr")}},
2948-
characteristics::DummyArguments{
2949-
characteristics::DummyArgument{"x"s,
2950-
characteristics::DummyDataObject{
2951-
std::move(*typeAndShape)}}},
2952-
characteristics::Procedure::Attrs{
2953-
characteristics::Procedure::Attr::Pure}}},
2944+
characteristics::DummyDataObject ddo{std::move(*typeAndShape)};
2945+
ddo.intent = common::Intent::In;
2946+
return SpecificCall{
2947+
SpecificIntrinsic{"__builtin_c_loc"s,
2948+
characteristics::Procedure{
2949+
characteristics::FunctionResult{
2950+
DynamicType{GetBuiltinDerivedType(
2951+
builtinsScope_, "__builtin_c_ptr")}},
2952+
characteristics::DummyArguments{
2953+
characteristics::DummyArgument{"x"s, std::move(ddo)}},
2954+
characteristics::Procedure::Attrs{
2955+
characteristics::Procedure::Attr::Pure}}},
29542956
std::move(arguments)};
29552957
}
29562958
}

‎flang/lib/Evaluate/type.cpp

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -807,7 +807,7 @@ std::optional<DynamicType> ComparisonType(
807807
}
808808
}
809809

810-
bool IsInteroperableIntrinsicType(const DynamicType &type,
810+
std::optional<bool> IsInteroperableIntrinsicType(const DynamicType &type,
811811
const common::LanguageFeatureControl *features, bool checkCharLength) {
812812
switch (type.category()) {
813813
case TypeCategory::Integer:
@@ -819,10 +819,17 @@ bool IsInteroperableIntrinsicType(const DynamicType &type,
819819
case TypeCategory::Logical:
820820
return type.kind() == 1; // C_BOOL
821821
case TypeCategory::Character:
822-
if (checkCharLength && type.knownLength().value_or(0) != 1) {
822+
if (type.kind() != 1) { // C_CHAR
823823
return false;
824+
} else if (checkCharLength) {
825+
if (type.knownLength()) {
826+
return *type.knownLength() == 1;
827+
} else {
828+
return std::nullopt;
829+
}
830+
} else {
831+
return true;
824832
}
825-
return type.kind() == 1 /* C_CHAR */;
826833
default:
827834
// Derived types are tested in Semantics/check-declarations.cpp
828835
return false;

‎flang/lib/Semantics/check-declarations.cpp

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -2982,7 +2982,8 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
29822982
msgs.Annex(std::move(bad));
29832983
}
29842984
} else if (!IsInteroperableIntrinsicType(
2985-
*type, context_.languageFeatures())) {
2985+
*type, context_.languageFeatures())
2986+
.value_or(false)) {
29862987
auto maybeDyType{evaluate::DynamicType::From(*type)};
29872988
if (type->category() == DeclTypeSpec::Logical) {
29882989
if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool)) {
@@ -3084,7 +3085,8 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(const Symbol &symbol) {
30843085
type->characterTypeSpec().length().isDeferred()) {
30853086
// ok; F'2023 18.3.7 p2(6)
30863087
} else if (derived ||
3087-
IsInteroperableIntrinsicType(*type, context_.languageFeatures())) {
3088+
IsInteroperableIntrinsicType(*type, context_.languageFeatures())
3089+
.value_or(false)) {
30883090
// F'2023 18.3.7 p2(4,5)
30893091
} else if (type->category() == DeclTypeSpec::Logical) {
30903092
if (context_.ShouldWarn(common::UsageWarning::LogicalVsCBool) &&

‎flang/lib/Semantics/type.cpp

Lines changed: 6 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -891,10 +891,13 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &o, const DeclTypeSpec &x) {
891891
return o << x.AsFortran();
892892
}
893893

894-
bool IsInteroperableIntrinsicType(
894+
std::optional<bool> IsInteroperableIntrinsicType(
895895
const DeclTypeSpec &type, const common::LanguageFeatureControl &features) {
896-
auto dyType{evaluate::DynamicType::From(type)};
897-
return dyType && IsInteroperableIntrinsicType(*dyType, &features);
896+
if (auto dyType{evaluate::DynamicType::From(type)}) {
897+
return IsInteroperableIntrinsicType(*dyType, &features);
898+
} else {
899+
return std::nullopt;
900+
}
898901
}
899902

900903
} // namespace Fortran::semantics

‎flang/test/Semantics/c_loc01.f90

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ module m
88
contains
99
subroutine subr
1010
end
11-
subroutine test(assumedType, poly, nclen)
11+
subroutine test(assumedType, poly, nclen, n)
1212
type(*), target :: assumedType
1313
class(*), target :: poly
1414
type(c_ptr) cp
@@ -19,9 +19,12 @@ subroutine test(assumedType, poly, nclen)
1919
real, target :: arr(3)
2020
type(hasLen(1)), target :: clen
2121
type(hasLen(*)), target :: nclen
22+
integer, intent(in) :: n
2223
character(2), target :: ch
2324
real :: arr1(purefun1(c_loc(targ))) ! ok
2425
real :: arr2(purefun2(c_funloc(subr))) ! ok
26+
character(:), allocatable, target :: deferred
27+
character(n), pointer :: p2ch
2528
!ERROR: C_LOC() argument must be a data pointer or target
2629
cp = c_loc(notATarget)
2730
!ERROR: C_LOC() argument must be a data pointer or target
@@ -39,7 +42,9 @@ subroutine test(assumedType, poly, nclen)
3942
cp = c_loc(ch(2:1))
4043
!WARNING: C_LOC() argument has non-interoperable intrinsic type, kind, or length
4144
cp = c_loc(ch)
42-
cp = c_loc(ch(1:1)) ! ok)
45+
cp = c_loc(ch(1:1)) ! ok
46+
cp = c_loc(deferred) ! ok
47+
cp = c_loc(p2ch) ! ok
4348
!ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'
4449
cp = c_ptr(0)
4550
!ERROR: PRIVATE name '__address' is only accessible within module '__fortran_builtins'

0 commit comments

Comments
 (0)