Skip to content

Commit 8b38970

Browse files
ktrasktras
authored
[flang] Add image_index to list of intrinsics and add tests (#79519)
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.
1 parent c8c3fe7 commit 8b38970

File tree

5 files changed

+186
-2
lines changed

5 files changed

+186
-2
lines changed

‎flang/docs/Intrinsics.md

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -753,7 +753,7 @@ This phase currently supports all the intrinsic procedures listed above but the
753753

754754
| Intrinsic Category | Intrinsic Procedures Lacking Support |
755755
| --- | --- |
756-
| Coarray intrinsic functions | IMAGE_INDEX, COSHAPE |
756+
| Coarray intrinsic functions | COSHAPE |
757757
| Object characteristic inquiry functions | ALLOCATED, ASSOCIATED, EXTENDS_TYPE_OF, IS_CONTIGUOUS, PRESENT, RANK, SAME_TYPE, STORAGE_SIZE |
758758
| Type inquiry intrinsic functions | BIT_SIZE, DIGITS, EPSILON, HUGE, KIND, MAXEXPONENT, MINEXPONENT, NEW_LINE, PRECISION, RADIX, RANGE, TINY|
759759
| 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 |

‎flang/lib/Evaluate/intrinsics.cpp

Lines changed: 12 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -531,6 +531,17 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
531531
{"ieor", {{"i", OperandInt}, {"j", OperandInt, Rank::elementalOrBOZ}},
532532
OperandInt},
533533
{"ieor", {{"i", BOZ}, {"j", SameInt}}, SameInt},
534+
{"image_index",
535+
{{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector}},
536+
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
537+
{"image_index",
538+
{{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector},
539+
{"team", TeamType, Rank::scalar}},
540+
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
541+
{"image_index",
542+
{{"coarray", AnyData, Rank::coarray}, {"sub", AnyInt, Rank::vector},
543+
{"team_number", AnyInt, Rank::scalar}},
544+
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
534545
{"image_status", {{"image", SameInt}, OptionalTEAM}, DefaultInt},
535546
{"index",
536547
{{"string", SameCharNoLen}, {"substring", SameCharNoLen},
@@ -932,7 +943,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
932943
};
933944

934945
// TODO: Coarray intrinsic functions
935-
// IMAGE_INDEX, COSHAPE
946+
// COSHAPE
936947
// TODO: Non-standard intrinsic functions
937948
// SHIFT,
938949
// COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,

‎flang/lib/Semantics/check-call.cpp

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1433,6 +1433,27 @@ static void CheckAssociated(evaluate::ActualArguments &arguments,
14331433
}
14341434
}
14351435

1436+
// IMAGE_INDEX (F'2023 16.9.107)
1437+
static void CheckImage_Index(evaluate::ActualArguments &arguments,
1438+
parser::ContextualMessages &messages) {
1439+
if (arguments[1] && arguments[0]) {
1440+
if (const auto subArrShape{
1441+
evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
1442+
if (const auto *coarrayArgSymbol{UnwrapWholeSymbolOrComponentDataRef(
1443+
arguments[0]->UnwrapExpr())}) {
1444+
const auto coarrayArgCorank = coarrayArgSymbol->Corank();
1445+
if (const auto subArrSize = evaluate::ToInt64(*subArrShape->front())) {
1446+
if (subArrSize != coarrayArgCorank) {
1447+
messages.Say(arguments[1]->sourceLocation(),
1448+
"The size of 'SUB=' (%jd) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (%d)"_err_en_US,
1449+
static_cast<std::int64_t>(*subArrSize), coarrayArgCorank);
1450+
}
1451+
}
1452+
}
1453+
}
1454+
}
1455+
}
1456+
14361457
// MOVE_ALLOC (F'2023 16.9.147)
14371458
static void CheckMove_Alloc(evaluate::ActualArguments &arguments,
14381459
parser::ContextualMessages &messages) {
@@ -1702,6 +1723,8 @@ static void CheckSpecificIntrinsic(evaluate::ActualArguments &arguments,
17021723
const evaluate::SpecificIntrinsic &intrinsic) {
17031724
if (intrinsic.name == "associated") {
17041725
CheckAssociated(arguments, context, scope);
1726+
} else if (intrinsic.name == "image_index") {
1727+
CheckImage_Index(arguments, context.foldingContext().messages());
17051728
} else if (intrinsic.name == "move_alloc") {
17061729
CheckMove_Alloc(arguments, context.foldingContext().messages());
17071730
} else if (intrinsic.name == "present") {

‎flang/test/Semantics/image_index01.f90

Lines changed: 41 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,41 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1
2+
! Ensure standard-conforming image_index function references are
3+
! accepted, based on the 16.9.107 section of the Fortran 2023 standard
4+
5+
program image_index_test
6+
use iso_fortran_env, only: team_type
7+
implicit none
8+
9+
integer n, array(1), team_num
10+
integer scalar_coarray[*], array_coarray(1)[*], coarray_corank3[10, 0:9, 0:*]
11+
integer subscripts_corank1(1), subscripts_corank3(3)
12+
type(team_type) :: home, league(2)
13+
14+
!___ standard-conforming statements - IMAGE_INDEX(COARRAY, SUB) ___
15+
n = image_index(scalar_coarray, [1])
16+
n = image_index(scalar_coarray, subscripts_corank1)
17+
n = image_index(array_coarray, [1])
18+
n = image_index(array_coarray, subscripts_corank1)
19+
n = image_index(coarray=scalar_coarray, sub=subscripts_corank1)
20+
n = image_index(coarray_corank3, subscripts_corank3)
21+
n = image_index(sub=subscripts_corank1, coarray=scalar_coarray)
22+
23+
!___ standard-conforming statements - IMAGE_INDEX(COARRAY, SUB, TEAM) ___
24+
n = image_index(scalar_coarray, [1], home)
25+
n = image_index(scalar_coarray, subscripts_corank1, league(1))
26+
n = image_index(array_coarray, [1], home)
27+
n = image_index(array_coarray, subscripts_corank1, league(1))
28+
n = image_index(coarray_corank3, subscripts_corank3, league(1))
29+
n = image_index(coarray=scalar_coarray, sub=subscripts_corank1, team=home)
30+
n = image_index(team=home, sub=[1], coarray=scalar_coarray)
31+
32+
!___ standard-conforming statements - IMAGE_INDEX(COARRAY, SUB, TEAM_NUMBER) ___
33+
n = image_index(scalar_coarray, [1], team_num)
34+
n = image_index(scalar_coarray, subscripts_corank1, team_number=team_num)
35+
n = image_index(array_coarray, [1], team_num)
36+
n = image_index(array_coarray, subscripts_corank1, array(1))
37+
n = image_index(coarray_corank3, subscripts_corank3, team_num)
38+
n = image_index(coarray=scalar_coarray, sub=subscripts_corank1, team_number=team_num)
39+
n = image_index(team_number=team_num, sub=[1], coarray=scalar_coarray)
40+
41+
end program image_index_test

‎flang/test/Semantics/image_index02.f90

Lines changed: 109 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,109 @@
1+
! RUN: %python %S/test_errors.py %s %flang_fc1
2+
! Check for semantic errors in image_index() function references
3+
! based on the 16.9.107 section of the Fortran 2023 standard
4+
5+
program image_index_test
6+
use iso_c_binding, only: c_int32_t
7+
use iso_fortran_env, only: team_type
8+
implicit none
9+
10+
integer n, array(1), non_coarray, scalar, team_num
11+
integer scalar_coarray[*], array_coarray(1)[*], coarray_corank3[10, 0:9, 0:*], repeated_coarray[*]
12+
integer subscripts_corank1(1), subscripts_corank3(3), repeated_sub(1), multi_rank_array(3,3)
13+
integer, parameter :: const_subscripts_corank1(1) = [1]
14+
logical non_integer_array(1)
15+
type(team_type) :: home, league(2), wrong_result_type
16+
17+
!___ non-conforming statements ___
18+
19+
!ERROR: missing mandatory 'coarray=' argument
20+
n = image_index()
21+
22+
!ERROR: missing mandatory 'sub=' argument
23+
n = image_index(scalar_coarray)
24+
25+
!ERROR: 'sub=' argument has unacceptable rank 2
26+
n = image_index(scalar_coarray, multi_rank_array)
27+
28+
!ERROR: The size of 'SUB=' (1) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
29+
n = image_index(coarray_corank3, subscripts_corank1, league(1))
30+
31+
!ERROR: The size of 'SUB=' (1) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
32+
n = image_index(coarray_corank3, const_subscripts_corank1, league(1))
33+
34+
!ERROR: The size of 'SUB=' (1) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
35+
n = image_index(coarray_corank3, [1], league(1))
36+
37+
!ERROR: The size of 'SUB=' (6) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (3)
38+
n = image_index(coarray_corank3, [1,2,3,4,5,6])
39+
40+
!ERROR: missing mandatory 'coarray=' argument
41+
n = image_index(sub=[1])
42+
43+
!ERROR: unknown keyword argument to intrinsic 'image_index'
44+
n = image_index(team=home)
45+
46+
!ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'image_index'
47+
n = image_index(non_coarray, [1])
48+
49+
!ERROR: Actual argument for 'sub=' has bad type 'LOGICAL(4)'
50+
n = image_index(array_coarray, [.true.])
51+
52+
!ERROR: Actual argument for 'sub=' has bad type 'LOGICAL(4)'
53+
n = image_index(array_coarray, non_integer_array)
54+
55+
!ERROR: 'sub=' argument has unacceptable rank 0
56+
n = image_index(array_coarray, scalar)
57+
58+
!ERROR: unknown keyword argument to intrinsic 'image_index'
59+
n = image_index(scalar_coarray, subscripts_corank1, team=league)
60+
61+
!ERROR: unknown keyword argument to intrinsic 'image_index'
62+
n = image_index(scalar_coarray, [1], team=team_num)
63+
64+
!ERROR: too many actual arguments for intrinsic 'image_index'
65+
n = image_index(array_coarray, [1], home, team_num)
66+
67+
!ERROR: too many actual arguments for intrinsic 'image_index'
68+
n = image_index(array_coarray, [1], home, team_num)
69+
70+
!ERROR: unknown keyword argument to intrinsic 'image_index'
71+
n = image_index(array_coarray, [1], team=home, team=league(1))
72+
73+
!ERROR: repeated keyword argument to intrinsic 'image_index'
74+
n = image_index(coarray=scalar_coarray, sub=[1], coarray=repeated_coarray)
75+
76+
!ERROR: keyword argument to intrinsic 'image_index' was supplied positionally by an earlier actual argument
77+
n = image_index(scalar_coarray, [1], coarray=repeated_coarray)
78+
79+
!ERROR: repeated keyword argument to intrinsic 'image_index'
80+
n = image_index(scalar_coarray, sub=subscripts_corank1, sub=repeated_sub)
81+
82+
!ERROR: keyword argument to intrinsic 'image_index' was supplied positionally by an earlier actual argument
83+
n = image_index(scalar_coarray, subscripts_corank1, sub=repeated_sub)
84+
85+
!ERROR: unknown keyword argument to intrinsic 'image_index'
86+
n = image_index(scalar_coarray, [1], team_number=array)
87+
88+
!ERROR: unknown keyword argument to intrinsic 'image_index'
89+
n = image_index(scalar_coarray, [1], team_number=home)
90+
91+
!ERROR: unknown keyword argument to intrinsic 'image_index'
92+
n = image_index(array_coarray, [1], team=home, team_number=team_num)
93+
94+
!ERROR: unknown keyword argument to intrinsic 'image_index'
95+
n = image_index(c=scalar_coarray, [1])
96+
97+
!ERROR: unknown keyword argument to intrinsic 'image_index'
98+
n = image_index(scalar_coarray, subscripts=[1])
99+
100+
!ERROR: unknown keyword argument to intrinsic 'image_index'
101+
n = image_index(scalar_coarray, [1], team_num=team_num)
102+
103+
!ERROR: unknown keyword argument to intrinsic 'image_index'
104+
n = image_index(scalar_coarray, [1], teams=home)
105+
106+
!ERROR: No intrinsic or user-defined ASSIGNMENT(=) matches operand types TYPE(team_type) and INTEGER(4)
107+
wrong_result_type = image_index(scalar_coarray, subscripts_corank1)
108+
109+
end program image_index_test

0 commit comments

Comments
 (0)