[flang-commits] [flang] 574f9df - [flang] Extension: Accept Hollerith actual arguments as if they were BOZ
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue May 24 09:04:42 PDT 2022
Author: Peter Klausler
Date: 2022-05-24T09:04:31-07:00
New Revision: 574f9dfee86a8084b8fca43c850f8a3387c6c68b
URL: https://github.com/llvm/llvm-project/commit/574f9dfee86a8084b8fca43c850f8a3387c6c68b
DIFF: https://github.com/llvm/llvm-project/commit/574f9dfee86a8084b8fca43c850f8a3387c6c68b.diff
LOG: [flang] Extension: Accept Hollerith actual arguments as if they were BOZ
When a Hollerith (or short character) literal is presented as an actual
argument that corresponds to a dummy argument for which a BOZ literal
would be acceptable, treat the Hollerith as if it had been a BOZ
literal in the same way -- and with the same code -- as f18 already
does for the similar extension in DATA statements.
Differential Revision: https://reviews.llvm.org/D126144
Added:
Modified:
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-call.cpp
flang/lib/Semantics/check-call.h
flang/lib/Semantics/data-to-inits.cpp
Removed:
################################################################################
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 403625cc4cf03..2b56da846dd92 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -1076,6 +1076,11 @@ Constant<T> PackageConstant(std::vector<Scalar<T>> &&elements,
std::optional<Expr<SomeType>> DataConstantConversionExtension(
FoldingContext &, const DynamicType &, const Expr<SomeType> &);
+// Convert Hollerith or short character to a another type as if the
+// Hollerith data had been BOZ.
+std::optional<Expr<SomeType>> HollerithToBOZ(
+ FoldingContext &, const Expr<SomeType> &, const DynamicType &);
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index bc8b7087164ba..293c91b700502 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1125,6 +1125,25 @@ bool MayBePassedAsAbsentOptional(
IsAllocatableOrPointerObject(expr, context);
}
+std::optional<Expr<SomeType>> HollerithToBOZ(FoldingContext &context,
+ const Expr<SomeType> &expr, const DynamicType &type) {
+ if (std::optional<std::string> chValue{GetScalarConstantValue<Ascii>(expr)}) {
+ // Pad on the right with spaces when short, truncate the right if long.
+ // TODO: big-endian targets
+ auto bytes{static_cast<std::size_t>(
+ ToInt64(type.MeasureSizeInBytes(context, false)).value())};
+ BOZLiteralConstant bits{0};
+ for (std::size_t j{0}; j < bytes; ++j) {
+ char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
+ BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
+ bits = bits.IOR(chBOZ.SHIFTL(8 * j));
+ }
+ return ConvertToType(type, Expr<SomeType>{bits});
+ } else {
+ return std::nullopt;
+ }
+}
+
} // namespace Fortran::evaluate
namespace Fortran::semantics {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index e2725f49547db..19edc232fede9 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -167,15 +167,27 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
characteristics::TypeAndShape &actualType, bool isElemental,
evaluate::FoldingContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic *intrinsic,
- bool allowIntegerConversions) {
+ bool allowActualArgumentConversions) {
// Basic type & rank checking
parser::ContextualMessages &messages{context.messages()};
CheckCharacterActual(actual, dummy.type, actualType, context, messages);
- if (allowIntegerConversions) {
+ if (allowActualArgumentConversions) {
ConvertIntegerActual(actual, dummy.type, actualType, messages);
}
bool typesCompatible{dummy.type.type().IsTkCompatibleWith(actualType.type())};
+ if (!typesCompatible && dummy.type.Rank() == 0 &&
+ allowActualArgumentConversions) {
+ // Extension: pass Hollerith literal to scalar as if it had been BOZ
+ if (auto converted{
+ evaluate::HollerithToBOZ(context, actual, dummy.type.type())}) {
+ messages.Say(
+ "passing Hollerith or character literal as if it were BOZ"_port_en_US);
+ actual = *converted;
+ actualType.type() = dummy.type.type();
+ typesCompatible = true;
+ }
+ }
if (typesCompatible) {
if (isElemental) {
} else if (dummy.type.attrs().test(
@@ -683,7 +695,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
const characteristics::DummyArgument &dummy,
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
- bool allowIntegerConversions) {
+ bool allowActualArgumentConversions) {
auto &messages{context.messages()};
std::string dummyName{"dummy argument"};
if (!dummy.name.empty()) {
@@ -714,7 +726,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
object.type.Rank() == 0 && proc.IsElemental()};
CheckExplicitDataArg(object, dummyName, *expr, *type,
isElemental, context, scope, intrinsic,
- allowIntegerConversions);
+ allowActualArgumentConversions);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
IsBOZLiteral(*expr)) {
// ok
@@ -867,7 +879,7 @@ static parser::Messages CheckExplicitInterface(
const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
const evaluate::FoldingContext &context, const Scope *scope,
const evaluate::SpecificIntrinsic *intrinsic,
- bool allowIntegerConversions) {
+ bool allowActualArgumentConversions) {
parser::Messages buffer;
parser::ContextualMessages messages{context.messages().at(), &buffer};
RearrangeArguments(proc, actuals, messages);
@@ -878,7 +890,7 @@ static parser::Messages CheckExplicitInterface(
const auto &dummy{proc.dummyArguments.at(index++)};
if (actual) {
CheckExplicitInterfaceArg(*actual, dummy, proc, localContext, scope,
- intrinsic, allowIntegerConversions);
+ intrinsic, allowActualArgumentConversions);
} else if (!dummy.IsOptional()) {
if (dummy.name.empty()) {
messages.Say(
@@ -909,9 +921,9 @@ parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
bool CheckInterfaceForGeneric(const characteristics::Procedure &proc,
evaluate::ActualArguments &actuals, const evaluate::FoldingContext &context,
- bool allowIntegerConversions) {
+ bool allowActualArgumentConversions) {
return !CheckExplicitInterface(
- proc, actuals, context, nullptr, nullptr, allowIntegerConversions)
+ proc, actuals, context, nullptr, nullptr, allowActualArgumentConversions)
.AnyFatalError();
}
diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h
index 7c68f2bd8e2aa..f3a26f59249d4 100644
--- a/flang/lib/Semantics/check-call.h
+++ b/flang/lib/Semantics/check-call.h
@@ -46,6 +46,6 @@ parser::Messages CheckExplicitInterface(
// Checks actual arguments for the purpose of resolving a generic interface.
bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
evaluate::ActualArguments &, const evaluate::FoldingContext &,
- bool allowIntegerConversions = false);
+ bool allowActualArgumentConversions = false);
} // namespace Fortran::semantics
#endif
diff --git a/flang/lib/Semantics/data-to-inits.cpp b/flang/lib/Semantics/data-to-inits.cpp
index f392288bffb42..b3c786c18c940 100644
--- a/flang/lib/Semantics/data-to-inits.cpp
+++ b/flang/lib/Semantics/data-to-inits.cpp
@@ -274,24 +274,11 @@ DataInitializationCompiler<DSV>::ConvertElement(
if (auto converted{evaluate::ConvertToType(type, SomeExpr{expr})}) {
return {std::make_pair(std::move(*converted), false)};
}
- if (std::optional<std::string> chValue{
- evaluate::GetScalarConstantValue<evaluate::Ascii>(expr)}) {
- // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
- // (most) other Fortran compilers do. Pad on the right with spaces
- // when short, truncate the right if long.
- // TODO: big-endian targets
- auto bytes{static_cast<std::size_t>(evaluate::ToInt64(
- type.MeasureSizeInBytes(exprAnalyzer_.GetFoldingContext(), false))
- .value())};
- evaluate::BOZLiteralConstant bits{0};
- for (std::size_t j{0}; j < bytes; ++j) {
- char ch{j >= chValue->size() ? ' ' : chValue->at(j)};
- evaluate::BOZLiteralConstant chBOZ{static_cast<unsigned char>(ch)};
- bits = bits.IOR(chBOZ.SHIFTL(8 * j));
- }
- if (auto converted{evaluate::ConvertToType(type, SomeExpr{bits})}) {
- return {std::make_pair(std::move(*converted), true)};
- }
+ // Allow DATA initialization with Hollerith and kind=1 CHARACTER like
+ // (most) other Fortran compilers do.
+ if (auto converted{evaluate::HollerithToBOZ(
+ exprAnalyzer_.GetFoldingContext(), expr, type)}) {
+ return {std::make_pair(std::move(*converted), true)};
}
SemanticsContext &context{exprAnalyzer_.context()};
if (context.IsEnabled(common::LanguageFeature::LogicalIntegerAssignment)) {
More information about the flang-commits
mailing list