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

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/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.

>From 7243309972d44eea344d7cae1f6ce96f460bc289 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 22 Jan 2024 11:28:00 -0800
Subject: [PATCH] [flang] Don't create impossible conversions in intrinsic
 extension

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.
---
 flang/lib/Evaluate/fold-implementation.h |  9 ++++--
 flang/lib/Evaluate/intrinsics.cpp        | 38 ++++++++++++++----------
 flang/test/Evaluate/bug78932.f90         |  4 +++
 3 files changed, 33 insertions(+), 18 deletions(-)
 create mode 100644 flang/test/Evaluate/bug78932.f90

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