Skip to content

[flang] Add image_index to list of intrinsics and add tests #79519

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 2 commits into from
Jan 31, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion flang/docs/Intrinsics.md
Original file line number Diff line number Diff line change
Expand Up @@ -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 |
Expand Down
13 changes: 12 additions & 1 deletion flang/lib/Evaluate/intrinsics.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -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},
Expand Down Expand Up @@ -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,
Expand Down
23 changes: 23 additions & 0 deletions flang/lib/Semantics/check-call.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -1433,6 +1433,27 @@ 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 (const auto subArrShape{
evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
if (const auto *coarrayArgSymbol{UnwrapWholeSymbolOrComponentDataRef(
arguments[0]->UnwrapExpr())}) {
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);
}
}
}
}
}
}

// MOVE_ALLOC (F'2023 16.9.147)
static void CheckMove_Alloc(evaluate::ActualArguments &arguments,
parser::ContextualMessages &messages) {
Expand Down Expand Up @@ -1678,6 +1699,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") {
Expand Down
41 changes: 41 additions & 0 deletions flang/test/Semantics/image_index01.f90
Original file line number Diff line number Diff line change
@@ -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
109 changes: 109 additions & 0 deletions flang/test/Semantics/image_index02.f90
Original file line number Diff line number Diff line change
@@ -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 '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 '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 '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 '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
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