[flang] Use LHS type for RHS BOZ on assignment

[klausler]

F'2023 allows the right-hand side of an assignment to an integer or real scalar to be a BOZ literal constant; this has already been supported in some compilers. The type of the left-hand side variable is used to convert the value of the BOZ.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

F'2023 allows the right-hand side of an assignment to an integer or real scalar to be a BOZ literal constant; this has already been supported in some compilers. The type of the left-hand side variable is used to convert the value of the BOZ.

---

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

2 Files Affected:

• (modified) flang/lib/Semantics/expression.cpp (+18-10)
• (added) flang/test/Semantics/boz-rhs.f90 (+8)

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 0659536aab98c..1e0c65d85d057 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -150,8 +150,9 @@ class ArgumentAnalyzer {
   }
   void Analyze(const parser::Variable &);
   void Analyze(const parser::ActualArgSpec &, bool isSubroutine);
-  void ConvertBOZ(std::optional<DynamicType> *thisType, std::size_t,
+  void ConvertBOZOperand(std::optional<DynamicType> *thisType, std::size_t,
       std::optional<DynamicType> otherType);
+  void ConvertBOZAssignmentRHS(const DynamicType &lhsType);
 
   bool IsIntrinsicRelational(
       RelationalOperator, const DynamicType &, const DynamicType &) const;
@@ -3765,8 +3766,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.ConvertBOZOperand(&leftType, 0, rightType);
+    analyzer.ConvertBOZOperand(&rightType, 1, leftType);
     if (leftType && rightType &&
         analyzer.IsIntrinsicRelational(opr, *leftType, *rightType)) {
       analyzer.CheckForNullPointer("as a relational operand");
@@ -4677,12 +4678,8 @@ std::optional<ProcedureRef> ArgumentAnalyzer::TryDefinedAssignment() {
         if (!IsAllocatableDesignator(lhs) || context_.inWhereBody()) {
           AddAssignmentConversion(*lhsType, *rhsType);
         }
-      } else {
-        if (lhsType->category() == TypeCategory::Integer ||
-            lhsType->category() == TypeCategory::Unsigned ||
-            lhsType->category() == TypeCategory::Real) {
-          ConvertBOZ(nullptr, 1, lhsType);
-        }
+      } else if (IsBOZLiteral(1)) {
+        ConvertBOZAssignmentRHS(*lhsType);
         if (IsBOZLiteral(1)) {
           context_.Say(
               "Right-hand side of this assignment may not be BOZ"_err_en_US);
@@ -4919,7 +4916,7 @@ int ArgumentAnalyzer::GetRank(std::size_t i) const {
 // UNSIGNED; 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::ConvertBOZOperand(std::optional<DynamicType> *thisType,
     std::size_t i, std::optional<DynamicType> otherType) {
   if (IsBOZLiteral(i)) {
     Expr<SomeType> &&argExpr{MoveExpr(i)};
@@ -4952,6 +4949,17 @@ void ArgumentAnalyzer::ConvertBOZ(std::optional<DynamicType> *thisType,
   }
 }
 
+void ArgumentAnalyzer::ConvertBOZAssignmentRHS(const DynamicType &lhsType) {
+  if (lhsType.category() == TypeCategory::Integer ||
+      lhsType.category() == TypeCategory::Unsigned ||
+      lhsType.category() == TypeCategory::Real) {
+    Expr<SomeType> rhs{MoveExpr(1)};
+    if (MaybeExpr converted{ConvertToType(lhsType, std::move(rhs))}) {
+      actuals_[1] = std::move(*converted);
+    }
+  }
+}
+
 // Report error resolving opr when there is a user-defined one available
 void ArgumentAnalyzer::SayNoMatch(const std::string &opr, bool isAssignment) {
   std::string type0{TypeAsFortran(0)};
diff --git a/flang/test/Semantics/boz-rhs.f90 b/flang/test/Semantics/boz-rhs.f90
new file mode 100644
index 0000000000000..1f2991aa1781b
--- /dev/null
+++ b/flang/test/Semantics/boz-rhs.f90
@@ -0,0 +1,8 @@
+! RUN: %flang_fc1 -fdebug-unparse %s | FileCheck %s
+double precision dp
+integer(8) i64
+!CHECK: dp=1._8
+dp = z'3ff0000000000000'
+!CHECK: i64=-77129852189294865_8
+i64 = z'feedfacedeadbeef'
+end