[flang] Make 'num_images()' intrinsic

[ktras]

Summary

I added 'num_images()' to the list of functions that are evaluated as intrinsic. I also added a test file in flang/test/Semantics to test calls to 'num_images()'. There was a call to 'num_images()' in flang/test/Semantics/call10.f90 that expected an error, now it no longer produces an error. So I edited that file accordingly. I also edited the intrinsics unit test to add further testing of 'num_images()'.

[sscalpone]

Please remove num_images from the list of unimplemented intrinsics in flang/documentation/Intrinsics.md.

Looks good. Thanks!

flang/test/Semantics/call10.f90

188

I don't think you need a comment because you noted the reason in the commit message.

[klausler]

flang/lib/Evaluate/intrinsics.cpp

584

num_images is not an intrinsic procedure in subclause 16 of the standard; INTRINSIC NUM_IMAGES would not be a valid statement. It shouldn't be here with the actual intrinsics unless you're proposing to make it one as an extension.

[klausler]

LGTM, and thanks for the contribution.

flang/lib/Evaluate/intrinsics.cpp

584

Whoops, my mistake; I had it confused with another procedure.

[ktras]

Based on feedback, I have removed 'num_images()' from the to do list in the documentation intrinsics.md. I have also updated the test call10.f90 to remove an unnecessary comment.

[tskeith]

flang/test/Semantics/num_images.f90

15

Why is the error "too many actual arguments" rather than incorrect type?

23

Similar question here: team_number isn't an unknown keyword argument. The value has the wrong type.

Are these bad error messages found with other intrinsics or unique to `num_images?

[ktras]

flang/test/Semantics/num_images.f90

15

I believe it is because 'num_images()' is overloaded with 3 variants and one of these has no arguments. If an argument is found that doesn't fully match the versions of 'num_images()' that do have arguments, then it seems to be interpreting those incorrect calls as an call to the version with no arguments. Thus the error being "too many actual arguments" if the argument is of an unexpected type or "unknown keyword argument" if a correct keyword argument is used, but with an incorrect type. I haven't looked into if there is a way to change the logic of the errors being produced in these cases.

23

Replied in comment above.

[tskeith]

@ktras, do you have the necessary permissions to commit this or do you need someone to do it for you?

[ktras]

In D83142#2136615, @tskeith wrote:

@ktras, do you have the necessary permissions to commit this or do you need someone to do it for you?

No, I do not, so I would need someone to commit it for me if everything looks ready to go. Thank you all for your help!

[PeteSteinfeld]

@ktras, are you planning to implement the other coarray intrinsic functions?

[ktras]

In D83142#2137260, @PeteSteinfeld wrote:

@ktras, are you planning to implement the other coarray intrinsic functions?

Yes, that is my plan. I am looking at 'this_image()' next.

[PeteSteinfeld]

In D83142#2137875, @ktras wrote:

In D83142#2137260, @PeteSteinfeld wrote:

@ktras, are you planning to implement the other coarray intrinsic functions?

Yes, that is my plan. I am looking at 'this_image()' next.

Excellent! I'm working on some NAG tests that use coarrays, and they use this_image().

Thanks for doing this!

flang/documentation/Intrinsics.md

 
 ## Semantic Analysis
 F18 semantic expression analysis phase detects intrinsic procedure references,
 validates the argument types and deduces the return types.
 This phase currently supports all the intrinsic procedures listed above but the ones in the table below.
 
 | 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 |
 | Intrinsic subroutines |MVBITS (elemental), CPU_TIME, DATE_AND_TIME, EVENT_QUERY, EXECUTE_COMMAND_LINE, GET_COMMAND, GET_COMMAND_ARGUMENT, GET_ENVIRONMENT_VARIABLE, MOVE_ALLOC, RANDOM_INIT, RANDOM_NUMBER, RANDOM_SEED, SYSTEM_CLOCK |
 | Atomic intrinsic subroutines | ATOMIC_ADD &al. |
 | Collective intrinsic subroutines | CO_BROADCAST &al. |
 
 

flang/lib/Evaluate/intrinsics.cpp

static const IntrinsicInterface genericIntrinsicFunction[]{
     {"nearest", {{"x", SameReal}, {"s", AnyReal}}, SameReal},
     {"new_line", {{"x", SameChar, Rank::anyOrAssumedRank}}, SameChar,
         Rank::scalar, IntrinsicClass::inquiryFunction},
     {"nint", {{"a", AnyReal}, DefaultingKIND}, KINDInt},
     {"norm2", {{"x", SameReal, Rank::array}, OptionalDIM}, SameReal,
         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},
     {"out_of_range",
         {{"x", AnyReal}, {"mold", AnyInt, Rank::scalar},
             {"round", AnyLogical, Rank::scalar, Optionality::optional}},
         DefaultLogical},
     {"out_of_range", {{"x", AnyReal}, {"mold", AnyReal}}, DefaultLogical},
// NULL() is a special case handled in Probe() below
         {{"string", SameChar}, {"set", SameChar},
             {"back", AnyLogical, Rank::elemental, Optionality::optional},
             DefaultingKIND},
         KINDInt},
 };
 
 // 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,
 //  COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
 //  QCMPLX, DFLOAT, QEXT, QFLOAT, QREAL, DNUM,
 //  INUM, JNUM, KNUM, QNUM, RNUM, RAN, RANF, ILEN, SIZEOF,
 //  MCLOCK, SECNDS, COTAN, IBCHNG, ISHA, ISHC, ISHL, IXOR
 //  IARG, IARGC, NARGS, NUMARG, BADDRESS, IADDR, CACHESIZE,

flang/test/Semantics/call10.f90

pure subroutine s13
     !ERROR: An image control statement may not appear in a pure subprogram
     sync all ! C1599
   end subroutine
   pure subroutine s14
     integer :: img, nimgs, i[*], tmp
                                    ! 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
 
     if ( img .eq. 1 ) then
       !ERROR: An image control statement may not appear in a pure subprogram
       sync images( nimgs )          ! explicit sync 1 with last img
       tmp = i[ nimgs ]
       !ERROR: An image control statement may not appear in a pure subprogram
       sync images( nimgs )          ! explicit sync 2 with last img

flang/test/Semantics/num_images.f90

+! 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

flang/unittests/Evaluate/intrinsics.cpp

void TestIntrinsics() {
 
   // Allowed as extensions
   TestCall{defaults, table, "float"}
       .Push(Const(Scalar<Int8>{}))
       .DoCall(Real4::GetType());
   TestCall{defaults, table, "idint"}
       .Push(Const(Scalar<Real4>{}))
       .DoCall(Int4::GetType());
+
+  TestCall{defaults, table, "num_images"}.DoCall(Int4::GetType());
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Int1>{}))
+      .DoCall(Int4::GetType());
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Int4>{}))
+      .DoCall(Int4::GetType());
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Int8>{}))
+      .DoCall(Int4::GetType());
+  TestCall{defaults, table, "num_images"}
+      .Push(Named("team_number", Const(Scalar<Int4>{})))
+      .DoCall(Int4::GetType());
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Int4>{}))
+      .Push(Const(Scalar<Int4>{}))
+      .DoCall(); // too many args
+  TestCall{defaults, table, "num_images"}
+      .Push(Named("bad", Const(Scalar<Int4>{})))
+      .DoCall(); // bad keyword
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Char>{}))
+      .DoCall(); // bad type
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Log4>{}))
+      .DoCall(); // bad type
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Complex8>{}))
+      .DoCall(); // bad type
+  TestCall{defaults, table, "num_images"}
+      .Push(Const(Scalar<Real4>{}))
+      .DoCall(); // bad type
+
   // TODO: test other intrinsics
 }
 } // namespace Fortran::evaluate
 
 int main() {
   Fortran::evaluate::TestIntrinsics();
   return testing::Complete();
 }