[flang-commits] [flang] 0284777 - [flang] Accept BOZ literals for some actual arguments
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Jan 19 17:32:03 PST 2022
Author: Peter Klausler
Date: 2022-01-19T17:28:21-08:00
New Revision: 028477758d19398c91e3b17a749314b04560023b
URL: https://github.com/llvm/llvm-project/commit/028477758d19398c91e3b17a749314b04560023b
DIFF: https://github.com/llvm/llvm-project/commit/028477758d19398c91e3b17a749314b04560023b.diff
LOG: [flang] Accept BOZ literals for some actual arguments
Consistent with previously documented policy, in which
BOZ literals are accepted in non-standard-conforming circumstances
where they can be converted to an unambiguous known numeric type,
allow BOZ literals to be passed as an actual argument in a reference
to a procedure whose explicit interface has a corresponding dummy
argument with a numeric type to which the BOZ literal may be
converted. Improve error messages associated with BOZ literal
actual arguments, too: don't emit multiple errors.
Differential Revision: https://reviews.llvm.org/D117698
Added:
Modified:
flang/docs/Extensions.md
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/tools.cpp
flang/lib/Semantics/check-call.cpp
flang/test/Semantics/boz-literal-constants.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 70c3101512563..aa60800246ba3 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -131,8 +131,11 @@ end
that can hold them, if one exists.
* BOZ literals can be used as INTEGER values in contexts where the type is
unambiguous: the right hand sides of assigments and initializations
- of INTEGER entities, and as actual arguments to a few intrinsic functions
- (ACHAR, BTEST, CHAR). BOZ literals are interpreted as default INTEGER
+ of INTEGER entities, as actual arguments to a few intrinsic functions
+ (ACHAR, BTEST, CHAR), and as actual arguments of references to
+ procedures with explicit interfaces whose corresponding dummy
+ argument has a numeric type to which the BOZ literal may be
+ converted. BOZ literals are interpreted as default INTEGER only
when they appear as the first items of array constructors with no
explicit type. Otherwise, they generally cannot be used if the type would
not be known (e.g., `IAND(X'1',X'2')`).
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index a29d6865c2aa2..52741ec63338b 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1347,10 +1347,17 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
d.rank == Rank::elementalOrBOZ) {
continue;
} else {
- const IntrinsicDummyArgument &nextParam{dummy[j + 1]};
- messages.Say(
- "Typeless (BOZ) not allowed for both '%s=' & '%s=' arguments"_err_en_US, // C7109
- d.keyword, nextParam.keyword);
+ const IntrinsicDummyArgument *nextParam{
+ j + 1 < dummies ? &dummy[j + 1] : nullptr};
+ if (nextParam && nextParam->rank == Rank::elementalOrBOZ) {
+ messages.Say(
+ "Typeless (BOZ) not allowed for both '%s=' & '%s=' arguments"_err_en_US, // C7109
+ d.keyword, nextParam->keyword);
+ } else {
+ messages.Say(
+ "Typeless (BOZ) not allowed for '%s=' argument"_err_en_US,
+ d.keyword);
+ }
}
} else {
// NULL(), procedure, or procedure pointer
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 34a3b5dd7fcaa..707da891fd5a3 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -607,6 +607,9 @@ std::optional<Expr<SomeType>> ConvertToNumeric(int kind, Expr<SomeType> &&x) {
std::optional<Expr<SomeType>> ConvertToType(
const DynamicType &type, Expr<SomeType> &&x) {
+ if (type.IsTypelessIntrinsicArgument()) {
+ return std::nullopt;
+ }
switch (type.category()) {
case TypeCategory::Integer:
if (auto *boz{std::get_if<BOZLiteralConstant>(&x.u)}) {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index ba2b47fbb769c..18a1cc3259df7 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -635,6 +635,19 @@ static void CheckProcedureArg(evaluate::ActualArgument &arg,
}
}
+// Allow BOZ literal actual arguments when they can be converted to a known
+// dummy argument type
+static void ConvertBOZLiteralArg(
+ evaluate::ActualArgument &arg, const evaluate::DynamicType &type) {
+ if (auto *expr{arg.UnwrapExpr()}) {
+ if (IsBOZLiteral(*expr)) {
+ if (auto converted{evaluate::ConvertToType(type, SomeExpr{*expr})}) {
+ arg = std::move(*converted);
+ }
+ }
+ }
+}
+
static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
const characteristics::DummyArgument &dummy,
const characteristics::Procedure &proc, evaluate::FoldingContext &context,
@@ -648,6 +661,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
std::visit(
common::visitors{
[&](const characteristics::DummyDataObject &object) {
+ ConvertBOZLiteralArg(arg, object.type.type());
if (auto *expr{arg.UnwrapExpr()}) {
if (auto type{characteristics::TypeAndShape::Characterize(
*expr, context)}) {
@@ -843,24 +857,35 @@ void CheckArguments(const characteristics::Procedure &proc,
const Scope &scope, bool treatingExternalAsImplicit,
const evaluate::SpecificIntrinsic *intrinsic) {
bool explicitInterface{proc.HasExplicitInterface()};
+ parser::ContextualMessages &messages{context.messages()};
+ if (!explicitInterface || treatingExternalAsImplicit) {
+ parser::Messages buffer;
+ {
+ auto restorer{messages.SetMessages(buffer)};
+ for (auto &actual : actuals) {
+ if (actual) {
+ CheckImplicitInterfaceArg(*actual, messages);
+ }
+ }
+ }
+ if (!buffer.empty()) {
+ if (auto *msgs{messages.messages()}) {
+ msgs->Annex(std::move(buffer));
+ }
+ return; // don't pile on
+ }
+ }
if (explicitInterface) {
auto buffer{
CheckExplicitInterface(proc, actuals, context, scope, intrinsic)};
if (treatingExternalAsImplicit && !buffer.empty()) {
- if (auto *msg{context.messages().Say(
+ if (auto *msg{messages.Say(
"Warning: if the procedure's interface were explicit, this reference would be in error:"_en_US)}) {
buffer.AttachTo(*msg);
}
}
- if (auto *msgs{context.messages().messages()}) {
- msgs->Merge(std::move(buffer));
- }
- }
- if (!explicitInterface || treatingExternalAsImplicit) {
- for (auto &actual : actuals) {
- if (actual) {
- CheckImplicitInterfaceArg(*actual, context.messages());
- }
+ if (auto *msgs{messages.messages()}) {
+ msgs->Annex(std::move(buffer));
}
}
}
diff --git a/flang/test/Semantics/boz-literal-constants.f90 b/flang/test/Semantics/boz-literal-constants.f90
index a0db6faddea91..ca1676a696461 100644
--- a/flang/test/Semantics/boz-literal-constants.f90
+++ b/flang/test/Semantics/boz-literal-constants.f90
@@ -8,6 +8,13 @@ subroutine bozchecks
logical :: resbit
complex :: rescmplx
real :: dbl, e
+ interface
+ subroutine explicit(n, x, c)
+ integer :: n
+ real :: x
+ character :: c
+ end subroutine
+ end interface
! C7107
!ERROR: Invalid digit ('a') in BOZ literal 'b"110a"'
integer, parameter :: a = B"110A"
@@ -75,8 +82,17 @@ subroutine bozchecks
res = MERGE_BITS(B"1101",B"0011",B"1011")
res = MERGE_BITS(B"1101",3,B"1011")
+ !ERROR: Typeless (BOZ) not allowed for 'x=' argument
+ res = KIND(z'feedface')
+
res = REAL(B"1101")
+ !Ok
+ call explicit(z'deadbeef', o'666', 'a')
+
+ !ERROR: Actual argument 'z'55'' associated with dummy argument 'c=' is not a variable or typed expression
+ call explicit(z'deadbeef', o'666', b'01010101')
+
!ERROR: BOZ argument requires an explicit interface
call implictSub(Z'12345')
More information about the flang-commits
mailing list