[flang] Allow logical expressions as arguments with changed logical kind

[DavidTruby]

Summary

This patch enables logical expressions to be used as arguments when the
default logical kind is changed (e.g. using -fdefault-integer-8) by
converting the type of the logical expression argument to the type of
the dummy argument in the function.

[DavidTruby]

I'm not sure this is actually correct, and it doesn't deal with implicit subroutine/function calls yet, but it would be good to know if I am going in the right direction

[klausler]

Looks good so far.

[DavidTruby]

Do the same conversions for implicit functions as explicit ones.

I have limited doing the conversion to when the argument is a result of a
relational operation or is a constant, as I think in other cases it is
incorrect.

[DavidTruby]

Remove unnecessary includes added by editor

[klausler]

In D157600#4577360, @DavidTruby wrote:

Do the same conversions for implicit functions as explicit ones.

I have limited doing the conversion to when the argument is a result of a
relational operation or is a constant, as I think in other cases it is
incorrect.

So you'll convert the result of X .EQ. Y but not (X .EQ. Y) .AND. (A .EQ. B)?

[DavidTruby]

In D157600#4577387, @klausler wrote:

In D157600#4577360, @DavidTruby wrote:

Do the same conversions for implicit functions as explicit ones.

I have limited doing the conversion to when the argument is a result of a
relational operation or is a constant, as I think in other cases it is
incorrect.

So you'll convert the result of X .EQ. Y but not (X .EQ. Y) .AND. (A .EQ. B)?

Good point. The main issue is if I allow it for all cases then e.g. the

call baz(any(l))

in the tests forces the any to have KIND=8 rather than the correct KIND=1.
Do you think there's a better way of doing this than just or-ing the different possible nodes as I have above? I could add logical operations as well but that might not be the only one I've missed...

[klausler]

In D157600#4577549, @DavidTruby wrote:

In D157600#4577387, @klausler wrote:

In D157600#4577360, @DavidTruby wrote:

Do the same conversions for implicit functions as explicit ones.

I have limited doing the conversion to when the argument is a result of a
relational operation or is a constant, as I think in other cases it is
incorrect.

So you'll convert the result of X .EQ. Y but not (X .EQ. Y) .AND. (A .EQ. B)?

Good point. The main issue is if I allow it for all types then e.g. the

call baz(any(l))

in the tests forces the any to have KIND=8 rather than the correct KIND=1.
Do you think there's a better way of doing this than just or-ing the different possible nodes as I have above? I could add logical operations as well but that might not be the only one I've missed...

I don't think that it matters what the actual argument expression is, so long as it is indeed an expression and not a variable.

[DavidTruby]

I don't think that it matters what the actual argument expression is, so long as it is indeed an expression and not a variable.

I think it would give the implicitly declared subroutine for baz in the test case the wrong type, which could cause issues if that subroutine is defined in another translation unit? Then again I'm not 100% sure what the rules for implicitly defined subroutines are.

[klausler]

In D157600#4577563, @DavidTruby wrote:

I don't think that it matters what the actual argument expression is, so long as it is indeed an expression and not a variable.

I think it would give the implicitly declared subroutine for baz in the test case the wrong type, which could cause issues if that subroutine is defined in another translation unit? Then again I'm not 100% sure what the rules for implicitly defined subroutines are.

That's right; never mind.

[DavidTruby]

I think for explicitly declared functions we could allow that case to pass anyway, it would make sense at least to me (although it doesn't work on gfortran). For implicit functions we will need to be careful not to include it to not change the implicit declaration though. What I'm not sure about is from which direction would be better to restrict it (i.e., ! (FunctionCall || ...) or (Relational || Constant || ...) as is already there). Or if there might be a better way entirely.
The problem I hit when trying to do it from the other side is I had to include every kind, and still wasn't sure I'd excluded everything relevant.

[klausler]

In D157600#4578066, @DavidTruby wrote:

I think for explicitly declared functions we could allow that case to pass anyway, it would make sense at least to me (although it doesn't work on gfortran). For implicit functions we will need to be careful not to include it to not change the implicit declaration though. What I'm not sure about is from which direction would be better to restrict it (i.e., ! (FunctionCall || ...) or (Relational || Constant || ...) as is already there). Or if there might be a better way entirely.
The problem I hit when trying to do it from the other side is I had to include every kind, and still wasn't sure I'd excluded everything relevant.

Yes, actual argument expressions (not variables) to specific procedures with explicit interfaces are generally safe to convert to the type of the dummy argument.

I am now somewhat more concerned with causing bad interactions with generic interface resolution.

I'll think about this some more and get back to you. We might just have to go with your original idea of removing LogicalResult after all.

[DavidTruby]

In D157600#4578131, @klausler wrote:

Yes, actual argument expressions (not variables) to specific procedures with explicit interfaces are generally safe to convert to the type of the dummy argument.

In the short term the explicit interface case is actually in interaction that's causing an issue for us. Would you be ok with me going back to (something like) the patch I had yesterday where we just handle the explicit case while we consider the implicit case further?

[klausler]

In D157600#4578205, @DavidTruby wrote:

In D157600#4578131, @klausler wrote:

Yes, actual argument expressions (not variables) to specific procedures with explicit interfaces are generally safe to convert to the type of the dummy argument.

In the short term the explicit interface case is actually in interaction that's causing an issue for us. Would you be ok with me going back to (something like) the patch I had yesterday where we just handle the explicit case while we consider the implicit case further?

Sure.

[DavidTruby]

Reverted to only performing for explicit procedures

flang/lib/Semantics/check-call.cpp

 //===-- lib/Semantics/check-call.cpp --------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "check-call.h"
 #include "definable.h"
 #include "pointer-assignment.h"
+#include "flang/Evaluate/call.h"
 #include "flang/Evaluate/characteristics.h"
 #include "flang/Evaluate/check-expression.h"
+#include "flang/Evaluate/constant.h"
+#include "flang/Evaluate/expression.h"
 #include "flang/Evaluate/fold-designator.h"
 #include "flang/Evaluate/shape.h"
 #include "flang/Evaluate/tools.h"
+#include "flang/Evaluate/type.h"
 #include "flang/Parser/characters.h"
 #include "flang/Parser/message.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/tools.h"
+#include "flang/Semantics/type.h"
 #include <map>
 #include <string>
 
 using namespace Fortran::parser::literals;
 namespace characteristics = Fortran::evaluate::characteristics;
 
 namespace Fortran::semantics {
 
+// Automatic conversion of different-kind LOGICAL scalar actual argument
+// expressions that are constants or results of relational operators to LOGICAL
+// scalar dummies when the dummy is of default logical kind or is implicit. This
+// allows these expressions in dummy arguments to work when the default logical
+// kind is not the one used in LogicalResult. This will always be safe even when
+// downconverting so no warning is needed.
+static void ConvertLogicalResult(evaluate::Expr<evaluate::SomeType> &actual,
+    characteristics::TypeAndShape &actualType,
+    evaluate::FoldingContext &context) {
+  auto defaultLogicalKind{
+      context.defaults().GetDefaultKind(TypeCategory::Logical)};
+  auto argChars{characteristics::DummyArgument::FromActual(
+      "actual argument", actual, context)};
+  if (actualType.type().category() == TypeCategory::Logical &&
+      actualType.type().kind() != defaultLogicalKind &&
+      (evaluate::UnwrapExpr<evaluate::Relational<evaluate::SomeType>>(actual) ||
+          evaluate::UnwrapExpr<evaluate::Constant<evaluate::LogicalResult>>(
+              actual)) &&
+      !evaluate::IsVariable(actual)) {
+    evaluate::DynamicType defaultLogicalType{
+        TypeCategory::Logical, defaultLogicalKind};
+    auto converted{
+        evaluate::ConvertToType(defaultLogicalType, std::move(actual))};
+    CHECK(converted);
+    actual = std::move(*converted);
+    actualType.set_type(defaultLogicalType);
+  }
+}
+
 static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
     parser::ContextualMessages &messages, evaluate::FoldingContext &context) {
   auto restorer{
       messages.SetLocation(arg.sourceLocation().value_or(messages.at()))};
   if (auto kw{arg.keyword()}) {
     messages.Say(*kw,
         "Keyword '%s=' may not appear in a reference to a procedure with an implicit interface"_err_en_US,
         *kw);
   }
   if (auto type{arg.GetType()}) {
     if (type->IsAssumedType()) {
       messages.Say(
           "Assumed type argument requires an explicit interface"_err_en_US);
     } else if (type->IsPolymorphic()) {
       messages.Say(
           "Polymorphic argument requires an explicit interface"_err_en_US);
     } else if (const DerivedTypeSpec * derived{GetDerivedTypeSpec(type)}) {
       if (!derived->parameters().empty()) {
         messages.Say(
             "Parameterized derived type argument requires an explicit interface"_err_en_US);
       }
     }
   }
-  if (const auto *expr{arg.UnwrapExpr()}) {
+  if (auto *expr{arg.UnwrapExpr()}) {
+    if (auto type{
+            characteristics::TypeAndShape::Characterize(*expr, context)}) {
+      ConvertLogicalResult(*expr, *type, context);
+    }
     if (IsBOZLiteral(*expr)) {
       messages.Say("BOZ argument requires an explicit interface"_err_en_US);
     } else if (evaluate::IsNullPointer(*expr)) {
       messages.Say(
           "Null pointer argument requires an explicit interface"_err_en_US);
     } else if (auto named{evaluate::ExtractNamedEntity(*expr)}) {
       const Symbol &symbol{named->GetLastSymbol()};
       if (symbol.Corank() > 0) {
bool typesCompatibleWithIgnoreTKR{
               actualType.type().category() == TypeCategory::Derived ||
               dummy.type.type().category() != actualType.type().category())) ||
       (dummy.ignoreTKR.test(common::IgnoreTKR::Kind) &&
           dummy.type.type().category() == actualType.type().category())};
   allowActualArgumentConversions &= !typesCompatibleWithIgnoreTKR;
   if (allowActualArgumentConversions) {
     ConvertIntegerActual(actual, dummy.type, actualType, messages);
   }
+  // ConvertLogicalActual(actual, dummy.type, actualType);
+  ConvertLogicalResult(actual, actualType, foldingContext);
   bool typesCompatible{typesCompatibleWithIgnoreTKR ||
       dummy.type.type().IsTkCompatibleWith(actualType.type())};
   int dummyRank{dummy.type.Rank()};
   if (!typesCompatible && dummyRank == 0 && allowActualArgumentConversions) {
     // Extension: pass Hollerith literal to scalar as if it had been BOZ
     if (auto converted{evaluate::HollerithToBOZ(
             foldingContext, actual, dummy.type.type())}) {
       messages.Say(

flang/test/Evaluate/logical-args.f90

+! Test that actual logical arguments convert to the right kind when it is non-default
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+! RUN: %flang_fc1 -fdebug-unparse -fdefault-integer-8 %s 2>&1 | FileCheck %s --check-prefixes CHECK-8
+
+program main
+  integer :: x(10), y
+  logical(kind=1) :: l(2)
+  ! CHECK: CALL foo(.true._4)
+  ! CHECK-8: CALL foo(logical(.true._4,kind=8))
+  call foo(1 < 2)
+  ! CHECK: CALL fooa(x>y)
+  ! CHECK-8: CALL fooa(logical(x>y,kind=8))
+  call fooa(x > y)
+
+  ! CHECK: CALL bar(.true._4)
+  ! CHECK-8: CALL bar(logical(.true._4,kind=8))
+  call bar(1 < 2)
+
+  ! Make sure we don't try to convert when the argument comes from an intrinsic
+  ! call with a non-default kind logical result
+  ! CHECK: CALL baz(any(l))
+  ! CHECK-8: CALL baz(any(l))
+  call baz(any(l))
+
+  contains
+    subroutine foo(l)
+      logical :: l
+    end subroutine foo
+
+    subroutine fooa(l)
+      logical :: l(10)
+    end subroutine fooa
+end program main