[flang-commits] [flang] [flang] Handle BOZ as right-hand side of assignment (PR #96672)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue Jun 25 11:10:08 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/96672
F'2023 allows BOZ to appear in more contexts, including the common extension of the right-hand side of an assignment to an INTEGER or REAL variable. Implement that one case now.
>From 87755a46c2b5b31e122fecef4a73a2d3f218c171 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 25 Jun 2024 11:08:05 -0700
Subject: [PATCH] [flang] Handle BOZ as right-hand side of assignment
F'2023 allows BOZ to appear in more contexts, including the common
extension of the right-hand side of an assignment to an INTEGER or
REAL variable. Implement that one case now.
---
flang/lib/Semantics/expression.cpp | 52 ++++++++++++-------
.../test/Semantics/boz-literal-constants.f90 | 16 ++++++
2 files changed, 49 insertions(+), 19 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index d80b3b65f0a98..7b4b91f795f91 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -141,7 +141,7 @@ class ArgumentAnalyzer {
}
void Analyze(const parser::Variable &);
void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
- void ConvertBOZ(std::optional<DynamicType> &thisType, std::size_t i,
+ void ConvertBOZ(std::optional<DynamicType> *thisType, std::size_t i,
std::optional<DynamicType> otherType);
bool IsIntrinsicRelational(
@@ -149,6 +149,9 @@ class ArgumentAnalyzer {
bool IsIntrinsicLogical() const;
bool IsIntrinsicNumeric(NumericOperator) const;
bool IsIntrinsicConcat() const;
+ bool IsBOZLiteral(std::size_t i) const {
+ return evaluate::IsBOZLiteral(GetExpr(i));
+ }
bool CheckConformance();
bool CheckAssignmentConformance();
@@ -186,9 +189,6 @@ class ArgumentAnalyzer {
const DynamicType &lhsType, const DynamicType &rhsType);
bool OkLogicalIntegerAssignment(TypeCategory lhs, TypeCategory rhs);
int GetRank(std::size_t) const;
- bool IsBOZLiteral(std::size_t i) const {
- return evaluate::IsBOZLiteral(GetExpr(i));
- }
void SayNoMatch(const std::string &, bool isAssignment = false);
std::string TypeAsFortran(std::size_t);
bool AnyUntypedOrMissingOperand();
@@ -3193,7 +3193,8 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
ArgumentAnalyzer analyzer{*this};
const auto &variable{std::get<parser::Variable>(x.t)};
analyzer.Analyze(variable);
- analyzer.Analyze(std::get<parser::Expr>(x.t));
+ const auto &expr{std::get<parser::Expr>(x.t)};
+ analyzer.Analyze(expr);
std::optional<Assignment> assignment;
if (!analyzer.fatalErrors()) {
auto restorer{GetContextualMessages().SetLocation(variable.GetSource())};
@@ -3203,17 +3204,26 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
"in a non-pointer intrinsic assignment statement");
analyzer.CheckForAssumedRank("in an assignment statement");
const Expr<SomeType> &lhs{analyzer.GetExpr(0)};
- if (auto dyType{lhs.GetType()};
- dyType && dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
- const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)};
- const Symbol *lastWhole{
- lastWhole0 ? &lastWhole0->GetUltimate() : nullptr};
- if (!lastWhole || !IsAllocatable(*lastWhole)) {
- Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
- } else if (evaluate::IsCoarray(*lastWhole)) {
- Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US);
+ if (auto dyType{lhs.GetType()}) {
+ if (dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
+ const Symbol *lastWhole0{UnwrapWholeSymbolOrComponentDataRef(lhs)};
+ const Symbol *lastWhole{
+ lastWhole0 ? &lastWhole0->GetUltimate() : nullptr};
+ if (!lastWhole || !IsAllocatable(*lastWhole)) {
+ Say("Left-hand side of assignment may not be polymorphic unless assignment is to an entire allocatable"_err_en_US);
+ } else if (evaluate::IsCoarray(*lastWhole)) {
+ Say("Left-hand side of assignment may not be polymorphic if it is a coarray"_err_en_US);
+ }
+ }
+ if (dyType->category() == TypeCategory::Integer ||
+ dyType->category() == TypeCategory::Real) {
+ analyzer.ConvertBOZ(nullptr, 1, dyType);
}
}
+ if (analyzer.IsBOZLiteral(1)) {
+ Say(expr.source,
+ "Right-hand side of this assignment may not be BOZ"_err_en_US);
+ }
}
assignment.emplace(analyzer.MoveExpr(0), analyzer.MoveExpr(1));
if (procRef) {
@@ -3573,8 +3583,8 @@ MaybeExpr RelationHelper(ExpressionAnalyzer &context, RelationalOperator opr,
if (!analyzer.fatalErrors()) {
std::optional<DynamicType> leftType{analyzer.GetType(0)};
std::optional<DynamicType> rightType{analyzer.GetType(1)};
- analyzer.ConvertBOZ(leftType, 0, rightType);
- analyzer.ConvertBOZ(rightType, 1, leftType);
+ analyzer.ConvertBOZ(&leftType, 0, rightType);
+ analyzer.ConvertBOZ(&rightType, 1, leftType);
if (leftType && rightType &&
analyzer.IsIntrinsicRelational(opr, *leftType, *rightType)) {
analyzer.CheckForNullPointer("as a relational operand");
@@ -4719,7 +4729,7 @@ int ArgumentAnalyzer::GetRank(std::size_t i) const {
// otherType. If it's REAL convert to REAL, otherwise convert to INTEGER.
// Note that IBM supports comparing BOZ literals to CHARACTER operands. That
// is not currently supported.
-void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> &thisType,
+void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> *thisType,
std::size_t i, std::optional<DynamicType> otherType) {
if (IsBOZLiteral(i)) {
Expr<SomeType> &&argExpr{MoveExpr(i)};
@@ -4729,13 +4739,17 @@ void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> &thisType,
MaybeExpr realExpr{
ConvertToKind<TypeCategory::Real>(kind, std::move(*boz))};
actuals_[i] = std::move(*realExpr);
- thisType.emplace(TypeCategory::Real, kind);
+ if (thisType) {
+ thisType->emplace(TypeCategory::Real, kind);
+ }
} else {
int kind{context_.context().GetDefaultKind(TypeCategory::Integer)};
MaybeExpr intExpr{
ConvertToKind<TypeCategory::Integer>(kind, std::move(*boz))};
actuals_[i] = std::move(*intExpr);
- thisType.emplace(TypeCategory::Integer, kind);
+ if (thisType) {
+ thisType->emplace(TypeCategory::Integer, kind);
+ }
}
}
}
diff --git a/flang/test/Semantics/boz-literal-constants.f90 b/flang/test/Semantics/boz-literal-constants.f90
index e6392f6f030e5..ee6919cb9ecd5 100644
--- a/flang/test/Semantics/boz-literal-constants.f90
+++ b/flang/test/Semantics/boz-literal-constants.f90
@@ -7,7 +7,12 @@ subroutine bozchecks
integer :: f, realpart = B"0101", img = B"1111", resint
logical :: resbit
complex :: rescmplx
+ character :: reschar
real :: dbl, e
+ type :: dt
+ integer :: n
+ end type
+ type(dt) :: resdt
interface
subroutine explicit(n, x, c)
integer :: n
@@ -98,6 +103,17 @@ subroutine explicit(n, x, c)
res = REAL(B"1101")
+ resint = z'ff' ! ok
+ res = z'3f800000' ! ok
+ !ERROR: Right-hand side of this assignment may not be BOZ
+ rescmplx = z'123'
+ !ERROR: Right-hand side of this assignment may not be BOZ
+ resbit = z'123'
+ !ERROR: Right-hand side of this assignment may not be BOZ
+ reschar = z'123'
+ !ERROR: Right-hand side of this assignment may not be BOZ
+ resdt = z'123'
+
!Ok
call explicit(z'deadbeef', o'666', 'a')
More information about the flang-commits
mailing list