diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h --- a/flang/include/flang/Evaluate/type.h +++ b/flang/include/flang/Evaluate/type.h @@ -452,6 +452,12 @@ int SelectedRealKind( std::int64_t precision = 0, std::int64_t range = 0, std::int64_t radix = 2); +// Given the dynamic types and kinds of two operands, determine the common +// type to which they must be converted in order to be compared with +// intrinsic OPERATOR(==) or .EQV. +std::optional ComparisonType( + const DynamicType &, const DynamicType &); + // For generating "[extern] template class", &c. boilerplate #define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \ M(P, S, 1) M(P, S, 2) M(P, S, 4) M(P, S, 8) M(P, S, 16) diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -436,6 +436,17 @@ ActualArguments &arg, FoldingContext &context) { if (arg[0]) { if (auto type{arg[0]->GetType()}) { + if constexpr (which == WhichLocation::Findloc) { + // Both ARRAY and VALUE are susceptible to conversion to a common + // comparison type. + if (arg[1]) { + if (auto valType{arg[1]->GetType()}) { + if (auto compareType{ComparisonType(*type, *valType)}) { + type = compareType; + } + } + } + } return common::SearchTypes( LocationHelper{std::move(*type), arg, context}); } diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -580,4 +580,58 @@ } } } + +std::optional ComparisonType( + const DynamicType &t1, const DynamicType &t2) { + switch (t1.category()) { + case TypeCategory::Integer: + switch (t2.category()) { + case TypeCategory::Integer: + return DynamicType{TypeCategory::Integer, std::max(t1.kind(), t2.kind())}; + case TypeCategory::Real: + case TypeCategory::Complex: + return t2; + default: + return std::nullopt; + } + case TypeCategory::Real: + switch (t2.category()) { + case TypeCategory::Integer: + return t1; + case TypeCategory::Real: + case TypeCategory::Complex: + return DynamicType{t2.category(), std::max(t1.kind(), t2.kind())}; + default: + return std::nullopt; + } + case TypeCategory::Complex: + switch (t2.category()) { + case TypeCategory::Integer: + return t1; + case TypeCategory::Real: + case TypeCategory::Complex: + return DynamicType{TypeCategory::Complex, std::max(t1.kind(), t2.kind())}; + default: + return std::nullopt; + } + case TypeCategory::Character: + switch (t2.category()) { + case TypeCategory::Character: + return DynamicType{ + TypeCategory::Character, std::max(t1.kind(), t2.kind())}; + default: + return std::nullopt; + } + case TypeCategory::Logical: + switch (t2.category()) { + case TypeCategory::Logical: + return DynamicType{TypeCategory::Logical, LogicalResult::kind}; + default: + return std::nullopt; + } + default: + return std::nullopt; + } +} + } // namespace Fortran::evaluate