[flang-commits] [flang] [flang] Accept KIND(x) when x is assumed-rank (PR #107787)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/107787

Don't emit a bogus error about being unable to forward an assumed-rank dummy argument as an actual argument in the case of the KIND intrinsic function.

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

>From 99e54786c3514e6df659f33245851db9d597d8c3 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Sun, 8 Sep 2024 16:41:48 -0700
Subject: [PATCH] [flang] Accept KIND(x) when x is assumed-rank

Don't emit a bogus error about being unable to forward an assumed-rank
dummy argument as an actual argument in the case of the KIND
intrinsic function.

Fixes https://github.com/llvm/llvm-project/issues/107782.
---
 flang/lib/Evaluate/intrinsics.cpp              | 2 +-
 flang/test/Evaluate/fold-assumed-rank-kind.f90 | 6 ++++++
 2 files changed, 7 insertions(+), 1 deletion(-)
 create mode 100644 flang/test/Evaluate/fold-assumed-rank-kind.f90

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index fcedf5ec3ddf83..382a3e860879f9 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -587,7 +587,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"izext", {{"i", AnyInt}}, TypePattern{IntType, KindCode::exactKind, 2}},
     {"jzext", {{"i", AnyInt}}, DefaultInt},
     {"kind",
-        {{"x", AnyIntrinsic, Rank::elemental, Optionality::required,
+        {{"x", AnyIntrinsic, Rank::anyOrAssumedRank, Optionality::required,
             common::Intent::In, {ArgFlag::canBeMoldNull}}},
         DefaultInt, Rank::elemental, IntrinsicClass::inquiryFunction},
     {"lbound",
diff --git a/flang/test/Evaluate/fold-assumed-rank-kind.f90 b/flang/test/Evaluate/fold-assumed-rank-kind.f90
new file mode 100644
index 00000000000000..674f60c6a0e2ff
--- /dev/null
+++ b/flang/test/Evaluate/fold-assumed-rank-kind.f90
@@ -0,0 +1,6 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+subroutine subr(ar)
+  real(8) :: ar(..)
+!CHECK:  PRINT *, 8_4
+  print *, kind(ar)
+end