[flang-commits] [flang] e633825 - [flang] Allow logical expressions as arguments with changed logical kind

[David Truby via flang-commits]

Author: David Truby
Date: 2023-08-14T13:05:21Z
New Revision: e63382542f0941b550839a226d0e2ad02a9de328

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

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

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.

Reviewed By: klausler

Differential Revision: https://reviews.llvm.org/D157600

Added: 
    flang/test/Evaluate/logical-args.f90

Modified: 
    flang/lib/Semantics/check-call.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index b8085f837add58..85aa1be81b6179 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -253,6 +253,26 @@ static void ConvertIntegerActual(evaluate::Expr<evaluate::SomeType> &actual,
   }
 }
 
+// Automatic conversion of 
diff erent-kind LOGICAL scalar actual argument
+// expressions (not variables) to LOGICAL scalar dummies when the dummy is of
+// default logical kind. This allows 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 ConvertLogicalActual(evaluate::Expr<evaluate::SomeType> &actual,
+    const characteristics::TypeAndShape &dummyType,
+    characteristics::TypeAndShape &actualType) {
+  if (dummyType.type().category() == TypeCategory::Logical &&
+      actualType.type().category() == TypeCategory::Logical &&
+      dummyType.type().kind() != actualType.type().kind() &&
+      !evaluate::IsVariable(actual)) {
+    auto converted{
+        evaluate::ConvertToType(dummyType.type(), std::move(actual))};
+    CHECK(converted);
+    actual = std::move(*converted);
+    actualType = dummyType;
+  }
+}
+
 static bool DefersSameTypeParameters(
     const DerivedTypeSpec &actual, const DerivedTypeSpec &dummy) {
   for (const auto &pair : actual.parameters()) {
@@ -294,6 +314,7 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
   if (allowActualArgumentConversions) {
     ConvertIntegerActual(actual, dummy.type, actualType, messages);
   }
+  ConvertLogicalActual(actual, dummy.type, actualType);
   bool typesCompatible{typesCompatibleWithIgnoreTKR ||
       dummy.type.type().IsTkCompatibleWith(actualType.type())};
   int dummyRank{dummy.type.Rank()};

diff  --git a/flang/test/Evaluate/logical-args.f90 b/flang/test/Evaluate/logical-args.f90
new file mode 100644
index 00000000000000..93531b04dfdf0b
--- /dev/null
+++ b/flang/test/Evaluate/logical-args.f90
@@ -0,0 +1,22 @@
+! 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
+  ! 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)
+
+  contains
+    subroutine foo(l)
+      logical :: l
+    end subroutine foo
+
+    subroutine fooa(l)
+      logical :: l(10)
+    end subroutine fooa
+end program main