[flang-commits] [flang] [flang] Add image_index to list of intrinsics and add tests (PR #79519)
Katherine Rasmussen via flang-commits
flang-commits at lists.llvm.org
Tue Jan 30 15:28:38 PST 2024
https://github.com/ktras updated https://github.com/llvm/llvm-project/pull/79519
>From d7e5955a99c1b96a1cc005935581d3bc926933df Mon Sep 17 00:00:00 2001
From: Katherine Rasmussen <krasmussen at lbl.gov>
Date: Wed, 24 Jan 2024 12:50:38 -0800
Subject: [PATCH 1/2] [flang] Add image_index to list of intrinsics and add
tests
Add image_index to the list of intrinsic functions and add
additional check on its args in check-call.cpp. Add two
semantics tests for image_index.
---
flang/docs/Intrinsics.md | 2 +-
flang/lib/Evaluate/intrinsics.cpp | 13 ++-
flang/lib/Semantics/check-call.cpp | 19 +++++
flang/test/Semantics/image_index01.f90 | 41 ++++++++++
flang/test/Semantics/image_index02.f90 | 109 +++++++++++++++++++++++++
5 files changed, 182 insertions(+), 2 deletions(-)
create mode 100644 flang/test/Semantics/image_index01.f90
create mode 100644 flang/test/Semantics/image_index02.f90
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5ade257403297..66ed2d05f2332 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -753,7 +753,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| Intrinsic Category | Intrinsic Procedures Lacking Support |
| --- | --- |
-| Coarray intrinsic functions | IMAGE_INDEX, COSHAPE |
+| Coarray intrinsic functions | COSHAPE |
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
| Non-standard intrinsic functions | AND, OR, XOR, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, QCMPLX, DREAL, DFLOAT, QEXT, QFLOAT, QREAL, DNUM, NUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF, MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR, IARG, IARGC, NARGS, GETPID, NUMARG, BADDRESS, IADDR, CACHESIZE, EOF, FP_CLASS, INT_PTR_KIND, ISNAN, MALLOC |
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index da6d597008988..20addc9cae363 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -529,6 +529,17 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"ieor", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
OperandInt},
{"ieor", {{"i", BOZ}, {"j", SameInt}}, SameInt},
+ {"image_index",
+ {{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector}},
+ DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"image_index",
+ {{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector},
+ {"team", TeamType, Rank::scalar}},
+ DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"image_index",
+ {{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector},
+ {"team_number", AnyInt, Rank::scalar}},
+ DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
{"image_status", {{"image", SameInt}, OptionalTEAM}, DefaultInt},
{"index",
{{"string", SameCharNoLen}, {"substring", SameCharNoLen},
@@ -930,7 +941,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
};
// TODO: Coarray intrinsic functions
-// IMAGE_INDEX, COSHAPE
+// COSHAPE
// TODO: Non-standard intrinsic functions
// SHIFT,
// COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index c924a817ec7e1..99b9c0426ffbc 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1433,6 +1433,23 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
}
}
+// IMAGE_INDEX (F'2023 16.9.107)
+static void CheckImage_Index(evaluate::ActualArguments &arguments,
+ parser::ContextualMessages &messages) {
+ if (arguments[1] && arguments[0]) {
+ if (auto subArrShape{evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
+ if (const auto *coarrayArgSymbol{UnwrapWholeSymbolOrComponentDataRef(
+ arguments[0]->UnwrapExpr())}) {
+ if (evaluate::ToInt64(*subArrShape->front()) !=
+ coarrayArgSymbol->Corank()) {
+ messages.Say(arguments[1]->sourceLocation(),
+ "The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument"_err_en_US);
+ }
+ }
+ }
+ }
+}
+
// MOVE_ALLOC (F'2023 16.9.147)
static void CheckMove_Alloc(evaluate::ActualArguments &arguments,
parser::ContextualMessages &messages) {
@@ -1678,6 +1695,8 @@ static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
const evaluate::SpecificIntrinsic &intrinsic) {
if (intrinsic.name == "associated") {
CheckAssociated(arguments, context, scope);
+ } else if (intrinsic.name == "image_index") {
+ CheckImage_Index(arguments, context.foldingContext().messages());
} else if (intrinsic.name == "move_alloc") {
CheckMove_Alloc(arguments, context.foldingContext().messages());
} else if (intrinsic.name == "reduce") {
diff --git a/flang/test/Semantics/image_index01.f90 b/flang/test/Semantics/image_index01.f90
new file mode 100644
index 0000000000000..1ed6779c69bdb
--- /dev/null
+++ b/flang/test/Semantics/image_index01.f90
@@ -0,0 +1,41 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Ensure standard-conforming image_index function references are
+! accepted, based on the 16.9.107 section of the Fortran 2023 standard
+
+program image_index_test
+ use iso_fortran_env, only: team_type
+ implicit none
+
+ integer n, array(1), team_num
+ integer scalar_coarray[*], array_coarray(1)[*], coarray_corank3[10, 0:9, 0:*]
+ integer subscripts_corank1(1), subscripts_corank3(3)
+ type(team_type) :: home, league(2)
+
+ !___ standard-conforming statements - IMAGE_INDEX(COARRAY, SUB) ___
+ n = image_index(scalar_coarray, [1])
+ n = image_index(scalar_coarray, subscripts_corank1)
+ n = image_index(array_coarray, [1])
+ n = image_index(array_coarray, subscripts_corank1)
+ n = image_index(coarray=scalar_coarray, sub=subscripts_corank1)
+ n = image_index(coarray_corank3, subscripts_corank3)
+ n = image_index(sub=subscripts_corank1, coarray=scalar_coarray)
+
+ !___ standard-conforming statements - IMAGE_INDEX(COARRAY, SUB, TEAM) ___
+ n = image_index(scalar_coarray, [1], home)
+ n = image_index(scalar_coarray, subscripts_corank1, league(1))
+ n = image_index(array_coarray, [1], home)
+ n = image_index(array_coarray, subscripts_corank1, league(1))
+ n = image_index(coarray_corank3, subscripts_corank3, league(1))
+ n = image_index(coarray=scalar_coarray, sub=subscripts_corank1, team=home)
+ n = image_index(team=home, sub=[1], coarray=scalar_coarray)
+
+ !___ standard-conforming statements - IMAGE_INDEX(COARRAY, SUB, TEAM_NUMBER) ___
+ n = image_index(scalar_coarray, [1], team_num)
+ n = image_index(scalar_coarray, subscripts_corank1, team_number=team_num)
+ n = image_index(array_coarray, [1], team_num)
+ n = image_index(array_coarray, subscripts_corank1, array(1))
+ n = image_index(coarray_corank3, subscripts_corank3, team_num)
+ n = image_index(coarray=scalar_coarray, sub=subscripts_corank1, team_number=team_num)
+ n = image_index(team_number=team_num, sub=[1], coarray=scalar_coarray)
+
+end program image_index_test
diff --git a/flang/test/Semantics/image_index02.f90 b/flang/test/Semantics/image_index02.f90
new file mode 100644
index 0000000000000..4a927e39c630d
--- /dev/null
+++ b/flang/test/Semantics/image_index02.f90
@@ -0,0 +1,109 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for semantic errors in image_index() function references
+! based on the 16.9.107 section of the Fortran 2023 standard
+
+program image_index_test
+ use iso_c_binding, only: c_int32_t
+ use iso_fortran_env, only: team_type
+ implicit none
+
+ integer n, array(1), non_coarray, scalar, team_num
+ integer scalar_coarray[*], array_coarray(1)[*], coarray_corank3[10, 0:9, 0:*], repeated_coarray[*]
+ integer subscripts_corank1(1), subscripts_corank3(3), repeated_sub(1), multi_rank_array(3,3)
+ integer, parameter :: const_subscripts_corank1(1) = [1]
+ logical non_integer_array(1)
+ type(team_type) :: home, league(2), wrong_result_type
+
+ !___ non-conforming statements ___
+
+ !ERROR: missing mandatory 'coarray=' argument
+ n = image_index()
+
+ !ERROR: missing mandatory 'sub=' argument
+ n = image_index(scalar_coarray)
+
+ !ERROR: 'sub=' argument has unacceptable rank 2
+ n = image_index(scalar_coarray, multi_rank_array)
+
+ !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ n = image_index(coarray_corank3, subscripts_corank1, league(1))
+
+ !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ n = image_index(coarray_corank3, const_subscripts_corank1, league(1))
+
+ !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ n = image_index(coarray_corank3, [1], league(1))
+
+ !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ n = image_index(coarray_corank3, [1,2,3,4,5,6])
+
+ !ERROR: missing mandatory 'coarray=' argument
+ n = image_index(sub=[1])
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(team=home)
+
+ !ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'image_index'
+ n = image_index(non_coarray, [1])
+
+ !ERROR: Actual argument for 'sub=' has bad type 'LOGICAL(4)'
+ n = image_index(array_coarray, [.true.])
+
+ !ERROR: Actual argument for 'sub=' has bad type 'LOGICAL(4)'
+ n = image_index(array_coarray, non_integer_array)
+
+ !ERROR: 'sub=' argument has unacceptable rank 0
+ n = image_index(array_coarray, scalar)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, subscripts_corank1, team=league)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, [1], team=team_num)
+
+ !ERROR: too many actual arguments for intrinsic 'image_index'
+ n = image_index(array_coarray, [1], home, team_num)
+
+ !ERROR: too many actual arguments for intrinsic 'image_index'
+ n = image_index(array_coarray, [1], home, team_num)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(array_coarray, [1], team=home, team=league(1))
+
+ !ERROR: repeated keyword argument to intrinsic 'image_index'
+ n = image_index(coarray=scalar_coarray, sub=[1], coarray=repeated_coarray)
+
+ !ERROR: keyword argument to intrinsic 'image_index' was supplied positionally by an earlier actual argument
+ n = image_index(scalar_coarray, [1], coarray=repeated_coarray)
+
+ !ERROR: repeated keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, sub=subscripts_corank1, sub=repeated_sub)
+
+ !ERROR: keyword argument to intrinsic 'image_index' was supplied positionally by an earlier actual argument
+ n = image_index(scalar_coarray, subscripts_corank1, sub=repeated_sub)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, [1], team_number=array)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, [1], team_number=home)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(array_coarray, [1], team=home, team_number=team_num)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(c=scalar_coarray, [1])
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, subscripts=[1])
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, [1], team_num=team_num)
+
+ !ERROR: unknown keyword argument to intrinsic 'image_index'
+ n = image_index(scalar_coarray, [1], teams=home)
+
+ !ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(team_type) and INTEGER(4)
+ wrong_result_type = image_index(scalar_coarray, subscripts_corank1)
+
+end program image_index_test
>From 030fbab5da7e59902e1106aff979aaf4cbd11e1c Mon Sep 17 00:00:00 2001
From: Katherine Rasmussen <krasmussen at lbl.gov>
Date: Tue, 30 Jan 2024 15:28:01 -0800
Subject: [PATCH 2/2] [flang] Updated error message for `image_index`
---
flang/lib/Semantics/check-call.cpp | 14 +++++++++-----
flang/test/Semantics/image_index02.f90 | 8 ++++----
2 files changed, 13 insertions(+), 9 deletions(-)
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 99b9c0426ffbc..a94c5df67408f 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1437,13 +1437,17 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
static void CheckImage_Index(evaluate::ActualArguments &arguments,
parser::ContextualMessages &messages) {
if (arguments[1] && arguments[0]) {
- if (auto subArrShape{evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
+ if (const auto subArrShape{
+ evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
if (const auto *coarrayArgSymbol{UnwrapWholeSymbolOrComponentDataRef(
arguments[0]->UnwrapExpr())}) {
- if (evaluate::ToInt64(*subArrShape->front()) !=
- coarrayArgSymbol->Corank()) {
- messages.Say(arguments[1]->sourceLocation(),
- "The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument"_err_en_US);
+ const auto coarrayArgCorank = coarrayArgSymbol->Corank();
+ if (const auto subArrSize = evaluate::ToInt64(*subArrShape->front())) {
+ if (subArrSize != coarrayArgCorank) {
+ messages.Say(arguments[1]->sourceLocation(),
+ "The size of 'SUB=' (%jd) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (%d)"_err_en_US,
+ static_cast<std::int64_t>(*subArrSize), coarrayArgCorank);
+ }
}
}
}
diff --git a/flang/test/Semantics/image_index02.f90 b/flang/test/Semantics/image_index02.f90
index 4a927e39c630d..1f296df2433c5 100644
--- a/flang/test/Semantics/image_index02.f90
+++ b/flang/test/Semantics/image_index02.f90
@@ -25,16 +25,16 @@ program image_index_test
!ERROR: 'sub=' argument has unacceptable rank 2
n = image_index(scalar_coarray, multi_rank_array)
- !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ !ERROR: The size of 'SUB=' (1) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
n = image_index(coarray_corank3, subscripts_corank1, league(1))
- !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ !ERROR: The size of 'SUB=' (1) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
n = image_index(coarray_corank3, const_subscripts_corank1, league(1))
- !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ !ERROR: The size of 'SUB=' (1) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
n = image_index(coarray_corank3, [1], league(1))
- !ERROR: The size of the 'sub=' argument for intrinsic 'image_index' must be equal to the corank of the 'coarray=' argument
+ !ERROR: The size of 'SUB=' (6) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
n = image_index(coarray_corank3, [1,2,3,4,5,6])
!ERROR: missing mandatory 'coarray=' argument
More information about the flang-commits
mailing list