[flang-commits] [flang] [flang] Support KNINT and KIDNNT legacy intrinsic functions (PR #79190)

[Peter Klausler via flang-commits]

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

These specific intrinsic functions are legacy names that map to the standard generic NINT(..., KIND=8).

>From 26976346038b18bd89901a84d21f545cab0cd92a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 23 Jan 2024 10:54:42 -0800
Subject: [PATCH] [flang] Support KNINT and KIDNNT legacy intrinsic functions

These specific intrinsic functions are legacy names that map
to the standard generic NINT(..., KIND=8).
---
 flang/lib/Evaluate/intrinsics.cpp |  6 ++++++
 flang/test/Evaluate/folding02.f90 | 30 +++++++++++++++++-------------
 2 files changed, 23 insertions(+), 13 deletions(-)

diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d5970089884c..9bacb6d825ae5ac 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1113,6 +1113,12 @@ static const SpecificIntrinsicInterface specificIntrinsicFunction[]{
     {{"kiabs", {{"a", TypePattern{IntType, KindCode::exactKind, 8}}},
          TypePattern{IntType, KindCode::exactKind, 8}},
         "abs"},
+    {{"kidnnt", {{"a", DoublePrecision}},
+         TypePattern{IntType, KindCode::exactKind, 8}},
+        "nint"},
+    {{"knint", {{"a", DefaultReal}},
+         TypePattern{IntType, KindCode::exactKind, 8}},
+        "nint"},
     {{"len", {{"string", DefaultChar, Rank::anyOrAssumedRank}}, DefaultInt,
         Rank::scalar, IntrinsicClass::inquiryFunction}},
     {{"lge", {{"string_a", DefaultChar}, {"string_b", DefaultChar}},
diff --git a/flang/test/Evaluate/folding02.f90 b/flang/test/Evaluate/folding02.f90
index 6374be35286cef2..89e2a09aa31b727 100644
--- a/flang/test/Evaluate/folding02.f90
+++ b/flang/test/Evaluate/folding02.f90
@@ -277,18 +277,22 @@ module m
     (1.3223499632715445262221010125358588993549346923828125_8, &
      1.7371201007364975854585509296157397329807281494140625_8))
 
-! Extension specific intrinsic variants of ABS
-  logical, parameter, test_babs1 = kind(babs(-1_1)) == 1
-  logical, parameter, test_babs2 = babs(-1_1) == 1_1
-  logical, parameter, test_iiabs1 = kind(iiabs(-1_2)) == 2
-  logical, parameter, test_iiabs2 = iiabs(-1_2) == 1_2
-  logical, parameter, test_jiabs1 = kind(jiabs(-1_4)) == 4
-  logical, parameter, test_jiabs2 = jiabs(-1_4) == 1_4
-  logical, parameter, test_kiabs1 = kind(kiabs(-1_8)) == 8
-  logical, parameter, test_kiabs2 = kiabs(-1_8) == 1_8
-  logical, parameter, test_zabs1 = kind(zabs((3._8,4._8))) == 8
-  logical, parameter, test_zabs2 = zabs((3._8,4._8)) == 5_8
-  logical, parameter, test_cdabs1 = kind(cdabs((3._8,4._8))) == kind(1.d0)
-  logical, parameter, test_cdabs2 = cdabs((3._8,4._8)) == real(5, kind(1.d0))
+! Extension specific intrinsic variants
+  logical, parameter :: test_babs1 = kind(babs(-1_1)) == 1
+  logical, parameter :: test_babs2 = babs(-1_1) == 1_1
+  logical, parameter :: test_iiabs1 = kind(iiabs(-1_2)) == 2
+  logical, parameter :: test_iiabs2 = iiabs(-1_2) == 1_2
+  logical, parameter :: test_jiabs1 = kind(jiabs(-1_4)) == 4
+  logical, parameter :: test_jiabs2 = jiabs(-1_4) == 1_4
+  logical, parameter :: test_kiabs1 = kind(kiabs(-1_8)) == 8
+  logical, parameter :: test_kiabs2 = kiabs(-1_8) == 1_8
+  logical, parameter :: test_zabs1 = kind(zabs((3._8,4._8))) == 8
+  logical, parameter :: test_zabs2 = zabs((3._8,4._8)) == 5_8
+  logical, parameter :: test_cdabs1 = kind(cdabs((3._8,4._8))) == kind(1.d0)
+  logical, parameter :: test_cdabs2 = cdabs((3._8,4._8)) == real(5, kind(1.d0))
+  logical, parameter :: test_kidnnt1 = kind(kidnnt(2.5d0)) == 8
+  logical, parameter :: test_kidnnt2 = kidnnt(2.5d0) == 3
+  logical, parameter :: test_knint1 = kind(knint(2.5)) == 8
+  logical, parameter :: test_knint2 = knint(2.5) == 3
 
 end