[flang] Use dynamic default REAL kind for conversions that were static

Original-commit: flang-compiler/f18@9a83fbbe95caf0596a4618938a177b0be1556acb
Reviewed-on: https://github.com/flang-compiler/f18/pull/195
Tree-same-pre-rewrite: false

diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc
index 13a3e42..41acb14 100644 (file)
--- a/flang/lib/evaluate/tools.cc
+++ b/flang/lib/evaluate/tools.cc
@@ -25,17 +25,18 @@ namespace Fortran::evaluate {
 // Conversions of complex component expressions to REAL.
 ConvertRealOperandsResult ConvertRealOperands(
     parser::ContextualMessages &messages, Expr<SomeType> &&x,
-    Expr<SomeType> &&y) {
+    Expr<SomeType> &&y, int defaultRealKind) {
   return std::visit(
-      common::visitors{
-          [&](Expr<SomeInteger> &&ix,
-              Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult {
-            // Can happen in a CMPLX() constructor.  Per F'2018,
-            // both integer operands are converted to default REAL.
-            return {AsSameKindExprs<TypeCategory::Real>(
-                AsCategoryExpr(ConvertToType<DefaultReal>(std::move(ix))),
-                AsCategoryExpr(ConvertToType<DefaultReal>(std::move(iy))))};
-          },
+      common::visitors{[&](Expr<SomeInteger> &&ix, Expr<SomeInteger> &&iy)
+                           -> ConvertRealOperandsResult {
+                         // Can happen in a CMPLX() constructor.  Per F'2018,
+                         // both integer operands are converted to default REAL.
+                         return {AsSameKindExprs<TypeCategory::Real>(
+                             ConvertToKind<TypeCategory::Real>(
+                                 defaultRealKind, std::move(ix)),
+                             ConvertToKind<TypeCategory::Real>(
+                                 defaultRealKind, std::move(iy)))};
+                       },
           [&](Expr<SomeInteger> &&ix,
               Expr<SomeReal> &&ry) -> ConvertRealOperandsResult {
             return {AsSameKindExprs<TypeCategory::Real>(
@@ -54,14 +55,18 @@ ConvertRealOperandsResult ConvertRealOperands(
           [&](Expr<SomeInteger> &&ix,
               BOZLiteralConstant &&by) -> ConvertRealOperandsResult {
             return {AsSameKindExprs<TypeCategory::Real>(
-                AsCategoryExpr(ConvertToType<DefaultReal>(std::move(ix))),
-                AsCategoryExpr(ConvertToType<DefaultReal>(std::move(by))))};
+                ConvertToKind<TypeCategory::Real>(
+                    defaultRealKind, std::move(ix)),
+                ConvertToKind<TypeCategory::Real>(
+                    defaultRealKind, std::move(by)))};
           },
           [&](BOZLiteralConstant &&bx,
               Expr<SomeInteger> &&iy) -> ConvertRealOperandsResult {
             return {AsSameKindExprs<TypeCategory::Real>(
-                AsCategoryExpr(ConvertToType<DefaultReal>(std::move(bx))),
-                AsCategoryExpr(ConvertToType<DefaultReal>(std::move(iy))))};
+                ConvertToKind<TypeCategory::Real>(
+                    defaultRealKind, std::move(bx)),
+                ConvertToKind<TypeCategory::Real>(
+                    defaultRealKind, std::move(iy)))};
           },
           [&](Expr<SomeReal> &&rx,
               BOZLiteralConstant &&by) -> ConvertRealOperandsResult {
@@ -118,9 +123,9 @@ std::optional<Expr<SomeType>> MixedRealLeft(
 
 std::optional<Expr<SomeComplex>> ConstructComplex(
     parser::ContextualMessages &messages, Expr<SomeType> &&real,
-    Expr<SomeType> &&imaginary) {
+    Expr<SomeType> &&imaginary, int defaultRealKind) {
   if (auto converted{ConvertRealOperands(
-          messages, std::move(real), std::move(imaginary))}) {
+          messages, std::move(real), std::move(imaginary), defaultRealKind)}) {
     return {std::visit(
         [](auto &&pair) {
           return MakeComplex(std::move(pair[0]), std::move(pair[1]));
@@ -132,10 +137,10 @@ std::optional<Expr<SomeComplex>> ConstructComplex(
 
 std::optional<Expr<SomeComplex>> ConstructComplex(
     parser::ContextualMessages &messages, std::optional<Expr<SomeType>> &&real,
-    std::optional<Expr<SomeType>> &&imaginary) {
+    std::optional<Expr<SomeType>> &&imaginary, int defaultRealKind) {
   if (auto parts{common::AllPresent(std::move(real), std::move(imaginary))}) {
     return ConstructComplex(messages, std::move(std::get<0>(*parts)),
-        std::move(std::get<1>(*parts)));
+        std::move(std::get<1>(*parts)), defaultRealKind);
   }
   return std::nullopt;
 }

diff --git a/flang/lib/evaluate/tools.h b/flang/lib/evaluate/tools.h
index ba0453f..a0061c0 100644 (file)
--- a/flang/lib/evaluate/tools.h
+++ b/flang/lib/evaluate/tools.h
@@ -195,11 +195,34 @@ Expr<SomeKind<CAT>> ConvertTo(
       to.u);
 }
 
-template<typename A, int N = 2> using SameExprs = std::array<Expr<A>, N>;
+// Convert an expression of some known category to a dynamically chosen
+// kind of some category (usually but not necessarily distinct).
+template<TypeCategory TOCAT, typename VALUE> struct ConvertToKindHelper {
+  using Result = std::optional<Expr<SomeKind<TOCAT>>>;
+  static constexpr std::size_t Types{std::tuple_size_v<CategoryTypes<TOCAT>>};
+  ConvertToKindHelper(int k, VALUE &&x) : kind{k}, value{std::move(x)} {}
+  template<std::size_t J> Result Test() {
+    using Ty = std::tuple_element_t<J, CategoryTypes<TOCAT>>;
+    if (kind == Ty::kind) {
+      return std::make_optional(
+          AsCategoryExpr(ConvertToType<Ty>(std::move(value))));
+    }
+    return std::nullopt;
+  }
+  int kind;
+  VALUE value;
+};
+
+template<TypeCategory TOCAT, typename VALUE>
+Expr<SomeKind<TOCAT>> ConvertToKind(int kind, VALUE &&x) {
+  return *common::SearchDynamicTypes(
+      ConvertToKindHelper<TOCAT, VALUE>{kind, std::move(x)});
+}
 
 // Given a type category CAT, SameKindExprs<CAT, N> is a variant that
 // holds an arrays of expressions of the same supported kind in that
 // category.
+template<typename A, int N = 2> using SameExprs = std::array<Expr<A>, N>;
 template<int N = 2> struct SameKindExprsHelper {
   template<typename A> using SameExprs = std::array<Expr<A>, N>;
 };
@@ -240,17 +263,20 @@ SameKindExprs<CAT, 2> AsSameKindExprs(
 // same kind of REAL.
 using ConvertRealOperandsResult =
     std::optional<SameKindExprs<TypeCategory::Real, 2>>;
-ConvertRealOperandsResult ConvertRealOperands(
-    parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
+ConvertRealOperandsResult ConvertRealOperands(parser::ContextualMessages &,
+    Expr<SomeType> &&, Expr<SomeType> &&,
+    int defaultRealKind = DefaultReal::kind);
 
 // Per F'2018 R718, if both components are INTEGER, they are both converted
 // to default REAL and the result is default COMPLEX.  Otherwise, the
 // kind of the result is the kind of most precise REAL component, and the other
 // component is converted if necessary to its type.
-std::optional<Expr<SomeComplex>> ConstructComplex(
-    parser::ContextualMessages &, Expr<SomeType> &&, Expr<SomeType> &&);
 std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
-    std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&);
+    Expr<SomeType> &&, Expr<SomeType> &&,
+    int defaultRealKind = DefaultReal::kind);
+std::optional<Expr<SomeComplex>> ConstructComplex(parser::ContextualMessages &,
+    std::optional<Expr<SomeType>> &&, std::optional<Expr<SomeType>> &&,
+    int defaultRealKind = DefaultReal::kind);
 
 template<typename A> Expr<TypeOf<A>> ScalarConstantToExpr(const A &x) {
   using Ty = TypeOf<A>;

diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc
index eb71847..accc561 100644 (file)
--- a/flang/lib/semantics/expression.cc
+++ b/flang/lib/semantics/expression.cc
@@ -422,8 +422,9 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::ComplexPart &x) {
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::ComplexLiteralConstant &z) {
-  return AsMaybeExpr(ConstructComplex(
-      context.messages, Analyze(std::get<0>(z.t)), Analyze(std::get<1>(z.t))));
+  return AsMaybeExpr(
+      ConstructComplex(context.messages, Analyze(std::get<0>(z.t)),
+          Analyze(std::get<1>(z.t)), defaults.defaultRealKind));
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::CharLiteralConstant &x) {
@@ -871,7 +872,7 @@ MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Subtract &x) {
 MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::ComplexConstructor &x) {
   return AsMaybeExpr(ConstructComplex(context.messages,
       AnalyzeHelper(*this, *std::get<0>(x.t)),
-      AnalyzeHelper(*this, *std::get<1>(x.t))));
+      AnalyzeHelper(*this, *std::get<1>(x.t)), defaults.defaultRealKind));
 }
 
 MaybeExpr ExprAnalyzer::Analyze(const parser::Expr::Concat &x) {