[flang] Fix COMPLEX/REAL `/` and `**` operand promotion

The real operand was always converted to the complex operand type.
The highest precison should be used instead. This fix converts the
real to a complex of the same kind before applying the promotion
rules for complex operands.
Reference to Fortran 2018 standard 10.9.1.3 that rules this added
in comments.

Original-commit: flang-compiler/f18@0d6b9c33aae59d80ff1b77f3561a6acb1db98645
Reviewed-on: https://github.com/flang-compiler/f18/pull/858

diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc
index 18e34ef..8a80a24 100644 (file)
--- a/flang/lib/evaluate/tools.cc
+++ b/flang/lib/evaluate/tools.cc
@@ -184,6 +184,20 @@ Expr<SomeReal> GetComplexPart(const Expr<SomeComplex> &z, bool isImaginary) {
       z.u);
 }
 
+// Convert REAL to COMPLEX of the same kind. Preserving the real operand kind
+// and then applying complex operand promotion rules allows the result to have
+// the highest precision of REAL and COMPLEX operands as required by Fortran
+// 2018 10.9.1.3.
+Expr<SomeComplex> PromoteRealToComplex(Expr<SomeReal> &&someX) {
+  return std::visit(
+      [](auto &&x) {
+        using RT = ResultType<decltype(x)>;
+        return AsCategoryExpr(ComplexConstructor<RT::kind>{
+            std::move(x), AsExpr(Constant<RT>{Scalar<RT>{}})});
+      },
+      std::move(someX.u));
+}
+
 // Handle mixed COMPLEX+REAL (or INTEGER) operations in a better way
 // than just converting the second operand to COMPLEX and performing the
 // corresponding COMPLEX+COMPLEX operation.
@@ -230,8 +244,13 @@ std::optional<Expr<SomeType>> MixedComplexLeft(
         std::move(zx.u)));
   } else if (defaultRealKind != 666) {  // dodge unused parameter warning
     // (a,b) ** x -> (a,b) ** (x,0)
-    Expr<SomeComplex> zy{ConvertTo(zx, std::move(iry))};
-    return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
+    if constexpr (RCAT == TypeCategory::Integer) {
+      Expr<SomeComplex> zy{ConvertTo(zx, std::move(iry))};
+      return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
+    } else {
+      Expr<SomeComplex> zy{PromoteRealToComplex(std::move(iry))};
+      return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
+    }
   }
   return NoExpr();
 }
@@ -264,8 +283,13 @@ std::optional<Expr<SomeType>> MixedComplexRight(
     }
   } else if (defaultRealKind != 666) {  // dodge unused parameter warning
     // x / (a,b) -> (x,0) / (a,b)
-    Expr<SomeComplex> zx{ConvertTo(zy, std::move(irx))};
-    return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
+    if constexpr (LCAT == TypeCategory::Integer) {
+      Expr<SomeComplex> zx{ConvertTo(zx, std::move(irx))};
+      return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
+    } else {
+      Expr<SomeComplex> zx{PromoteRealToComplex(std::move(irx))};
+      return Package(PromoteAndCombine<OPR>(std::move(zx), std::move(zy)));
+    }
   }
   return NoExpr();
 }

diff --git a/flang/test/evaluate/folding01.f90 b/flang/test/evaluate/folding01.f90
index c2a8382..cb10a3a 100644 (file)
--- a/flang/test/evaluate/folding01.f90
+++ b/flang/test/evaluate/folding01.f90
@@ -99,6 +99,8 @@ module m
   logical, parameter :: test_pow2 = (1**100).EQ.(1)
   logical, parameter :: test_pow3 = (2**4).EQ.(16)
   logical, parameter :: test_pow4 = (7**5).EQ.(16807)
+  logical, parameter :: test_pow5 = kind(real(1., kind=8)**cmplx(1., kind=4)).EQ.(8)
+  logical, parameter :: test_pow6 = kind(cmplx(1., kind=4)**real(1., kind=8)).EQ.(8)
 
   ! test MIN and MAX
   real, parameter :: x1 = -35., x2= -35.05, x3=0., x4=35.05, x5=35.