[flang] Don't create impossible conversions in intrinsic extension

[klausler]

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 #78932.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

Changes

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 #78932.

---

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

3 Files Affected:

• (modified) flang/lib/Evaluate/fold-implementation.h (+6-3)
• (modified) flang/lib/Evaluate/intrinsics.cpp (+23-15)
• (added) flang/test/Evaluate/bug78932.f90 (+4)

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 da6d5970089884c..1cbb0080d5cb9d8 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -3106,23 +3106,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

[jeanPerier]

LGTM