[flang-commits] [flang] d0f44ed - [flang] Don't create impossible conversions in intrinsic extension (#79042)

[via flang-commits]

Author: Peter Klausler
Date: 2024-01-25T16:18:20-08:00
New Revision: d0f44ed062d911953de157ee4d7db91003b9bd52

URL: https://github.com/llvm/llvm-project/commit/d0f44ed062d911953de157ee4d7db91003b9bd52
DIFF: https://github.com/llvm/llvm-project/commit/d0f44ed062d911953de157ee4d7db91003b9bd52.diff

LOG: [flang] Don't create impossible conversions in intrinsic extension (#79042)

We support specific intrinsic calls like `AMAX0(1.0,2)` that have
heterogeneous argument types as an optional extension in cases where the
specific intrinsic has a related generic intrinsic function capable of
handling the argument types. This feature can't be allowed to apply to
calls where the result of the related generic intrinsic function is not
convertible to the type of the specific intrinsic, as in `AMAX0('a',
'b')`.

Fixes https://github.com/llvm/llvm-project/issues/78932.

Added: 
    flang/test/Evaluate/bug78932.f90

Modified: 
    flang/lib/Evaluate/fold-implementation.h
    flang/lib/Evaluate/intrinsics.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index a1bde778e5ec07e..ed015da951090d5 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1124,14 +1124,17 @@ Expr<T> RewriteSpecificMINorMAX(
   intrinsic.characteristics.value().functionResult.value().SetType(*resultType);
   auto insertConversion{[&](const auto &x) -> Expr<T> {
     using TR = ResultType<decltype(x)>;
-    FunctionRef<TR> maxRef{std::move(funcRef.proc()), std::move(args)};
+    FunctionRef<TR> maxRef{
+        ProcedureDesignator{funcRef.proc()}, ActualArguments{args}};
     return Fold(context, ConvertToType<T>(AsCategoryExpr(std::move(maxRef))));
   }};
   if (auto *sx{UnwrapExpr<Expr<SomeReal>>(*resultTypeArg)}) {
     return common::visit(insertConversion, sx->u);
+  } else if (auto *sx{UnwrapExpr<Expr<SomeInteger>>(*resultTypeArg)}) {
+    return common::visit(insertConversion, sx->u);
+  } else {
+    return Expr<T>{std::move(funcRef)}; // error recovery
   }
-  auto &sx{DEREF(UnwrapExpr<Expr<SomeInteger>>(*resultTypeArg))};
-  return common::visit(insertConversion, sx.u);
 }
 
 // FoldIntrinsicFunction()

diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index e3a9d54136ae9a2..85c76b11d2c4538 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3105,23 +3105,31 @@ std::optional<SpecificCall> IntrinsicProcTable::Implementation::Probe(
             if (auto specificCall{
                     matchOrBufferMessages(*genIter->second, specificBuffer)}) {
               // Force the call result type to the specific intrinsic result
-              // type
+              // type, if possible.
+              DynamicType genericType{
+                  DEREF(specificCall->specificIntrinsic.characteristics.value()
+                            .functionResult.value()
+                            .GetTypeAndShape())
+                      .type()};
               DynamicType newType{GetReturnType(*specIter->second, defaults_)};
-              if (context.languageFeatures().ShouldWarn(
-                      common::LanguageFeature::
-                          UseGenericIntrinsicWhenSpecificDoesntMatch)) {
-                context.messages().Say(
-                    "Argument types do not match specific intrinsic '%s' "
-                    "requirements; using '%s' generic instead and converting "
-                    "the "
-                    "result to %s if needed"_port_en_US,
-                    call.name, genericName, newType.AsFortran());
+              if (genericType.category() == newType.category() ||
+                  ((genericType.category() == TypeCategory::Integer ||
+                       genericType.category() == TypeCategory::Real) &&
+                      (newType.category() == TypeCategory::Integer ||
+                          newType.category() == TypeCategory::Real))) {
+                if (context.languageFeatures().ShouldWarn(
+                        common::LanguageFeature::
+                            UseGenericIntrinsicWhenSpecificDoesntMatch)) {
+                  context.messages().Say(
+                      "Argument types do not match specific intrinsic '%s' requirements; using '%s' generic instead and converting the result to %s if needed"_port_en_US,
+                      call.name, genericName, newType.AsFortran());
+                }
+                specificCall->specificIntrinsic.name = call.name;
+                specificCall->specificIntrinsic.characteristics.value()
+                    .functionResult.value()
+                    .SetType(newType);
+                return specificCall;
               }
-              specificCall->specificIntrinsic.name = call.name;
-              specificCall->specificIntrinsic.characteristics.value()
-                  .functionResult.value()
-                  .SetType(newType);
-              return specificCall;
             }
           }
         }

diff  --git a/flang/test/Evaluate/bug78932.f90 b/flang/test/Evaluate/bug78932.f90
new file mode 100644
index 000000000000000..8fd3188e0b5cf3b
--- /dev/null
+++ b/flang/test/Evaluate/bug78932.f90
@@ -0,0 +1,4 @@
+!RUN: not %flang_fc1 %s 2>&1 | FileCheck %s
+!CHECK: error: Actual argument for 'a1=' has bad type 'CHARACTER(KIND=1,LEN=1_8)'
+real, parameter :: bad_amax0 = amax0('a', 'b')
+end