diff --git a/flang/documentation/Intrinsics.md b/flang/documentation/Intrinsics.md --- a/flang/documentation/Intrinsics.md +++ b/flang/documentation/Intrinsics.md @@ -701,7 +701,7 @@ | Intrinsic Category | Intrinsic Procedures Lacking Support | | --- | --- | -| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, NUM_IMAGES, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, COSHAPE | +| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, 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, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, COSD, SIND, TAND, ACOSD, ASIND, ATAND, ATAN2D, COMPL, DCMPLX, EQV, NEQV, INT8, JINT, JNINT, KNINT, LOC, 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, 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 --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -581,6 +581,10 @@ Rank::dimReduced, IntrinsicClass::transformationalFunction}, {"not", {{"i", SameInt}}, SameInt}, // NULL() is a special case handled in Probe() below + {"num_images", {}, DefaultInt, Rank::scalar, + IntrinsicClass::transformationalFunction}, + {"num_images", {{"team_number", AnyInt, Rank::scalar}}, DefaultInt, + Rank::scalar, IntrinsicClass::transformationalFunction}, {"out_of_range", {{"x", AnyIntOrReal}, {"mold", AnyIntOrReal, Rank::scalar}}, DefaultLogical}, @@ -724,7 +728,7 @@ // TODO: Coarray intrinsic functions // LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, -// NUM_IMAGES, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, +// STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, // COSHAPE // TODO: Non-standard intrinsic functions // AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, diff --git a/flang/test/Semantics/call10.f90 b/flang/test/Semantics/call10.f90 --- a/flang/test/Semantics/call10.f90 +++ b/flang/test/Semantics/call10.f90 @@ -185,7 +185,6 @@ ! implicit sync all !ERROR: Procedure 'this_image' referenced in pure subprogram 's14' must be pure too img = this_image() - !ERROR: Procedure 'num_images' referenced in pure subprogram 's14' must be pure too nimgs = num_images() i = img ! i is ready to use diff --git a/flang/test/Semantics/num_images.f90 b/flang/test/Semantics/num_images.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/num_images.f90 @@ -0,0 +1,30 @@ +! RUN: %S/test_errors.sh %s %t %f18 +! Check for semantic errors in num_images() function calls + +subroutine test + + ! correct calls, should produce no errors + print *, num_images() + print *, num_images(team_number=1) + print *, num_images(1) + + ! incorrectly typed argument + ! the error is seen as too many arguments to the num_images() call with no arguments + !ERROR: too many actual arguments for intrinsic 'num_images' + print *, num_images(3.4) + + ! call with too many arguments + !ERROR: too many actual arguments for intrinsic 'num_images' + print *, num_images(1, 1) + + ! keyword argument with incorrect type + !ERROR: unknown keyword argument to intrinsic 'num_images' + print *, num_images(team_number=3.4) + + ! incorrect keyword argument + !ERROR: unknown keyword argument to intrinsic 'num_images' + print *, num_images(team_numbers=1) + + !TODO: test num_images() calls related to team_type argument + +end subroutine diff --git a/flang/unittests/Evaluate/intrinsics.cpp b/flang/unittests/Evaluate/intrinsics.cpp --- a/flang/unittests/Evaluate/intrinsics.cpp +++ b/flang/unittests/Evaluate/intrinsics.cpp @@ -257,6 +257,40 @@ TestCall{defaults, table, "idint"} .Push(Const(Scalar{})) .DoCall(Int4::GetType()); + + TestCall{defaults, table, "num_images"}.DoCall(Int4::GetType()); + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(Int4::GetType()); + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(Int4::GetType()); + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(Int4::GetType()); + TestCall{defaults, table, "num_images"} + .Push(Named("team_number", Const(Scalar{}))) + .DoCall(Int4::GetType()); + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .Push(Const(Scalar{})) + .DoCall(); // too many args + TestCall{defaults, table, "num_images"} + .Push(Named("bad", Const(Scalar{}))) + .DoCall(); // bad keyword + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "num_images"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + // TODO: test other intrinsics } } // namespace Fortran::evaluate