[flang-commits] [flang] [flang] Handle BOZ as right-hand side of assignment (PR #96672)

via flang-commits flang-commits at lists.llvm.org
Tue Jun 25 11:10:38 PDT 2024


llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

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.

---
Full diff: https://github.com/llvm/llvm-project/pull/96672.diff


2 Files Affected:

- (modified) flang/lib/Semantics/expression.cpp (+33-19) 
- (modified) flang/test/Semantics/boz-literal-constants.f90 (+16) 


``````````diff
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')
 

``````````

</details>


https://github.com/llvm/llvm-project/pull/96672


More information about the flang-commits mailing list