[PATCH] D100897: [flang] Make 'team_number()' an intrinsic function

[Craig E Rasmussen via Phabricator via llvm-commits]

craig.rasmussen created this revision.
craig.rasmussen added reviewers: sscalpone, klausler.
craig.rasmussen requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

Added 'team_number()' to the list of functions that are evaluated as intrinsic. Also changed the type of TEAM_TYPE (in TypePattern) to be DerivedType rather than IntType.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D100897

Files:
  flang/docs/Intrinsics.md
  flang/lib/Evaluate/intrinsics.cpp
  flang/test/Semantics/team_number.f90


Index: flang/test/Semantics/team_number.f90
===================================================================
--- /dev/null
+++ flang/test/Semantics/team_number.f90
@@ -0,0 +1,21 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Check for semantic errors in team_number() function calls
+
+subroutine test
+  use, intrinsic :: iso_fortran_env, only: team_type
+  type(team_type) :: oregon
+
+  ! correct calls, should produce no errors
+  print *, team_number()
+  print *, team_number(oregon)
+  print *, team_number(team=oregon)
+
+  ! call with too many arguments
+  !ERROR: too many actual arguments for intrinsic 'team_number'
+  print *, team_number(1, 3)
+
+  ! keyword argument with incorrect type
+  !ERROR: unknown keyword argument to intrinsic 'team_number'
+  print *, team_number(team=3.1415)
+
+end subroutine
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -104,7 +104,7 @@
 static constexpr TypePattern DefaultLogical{
     LogicalType, KindCode::defaultLogicalKind};
 static constexpr TypePattern BOZ{IntType, KindCode::typeless};
-static constexpr TypePattern TEAM_TYPE{IntType, KindCode::teamType};
+static constexpr TypePattern TEAM_TYPE{DerivedType, KindCode::teamType};
 static constexpr TypePattern DoublePrecision{
     RealType, KindCode::doublePrecision};
 static constexpr TypePattern DoublePrecisionComplex{
@@ -233,6 +233,11 @@
     common::Intent::In};
 static constexpr IntrinsicDummyArgument OptionalMASK{"mask", AnyLogical,
     Rank::conformable, Optionality::optional, common::Intent::In};
+// Would rather use OptionalTEAM in team_number() rather than RequiredTEAM
+// static constexpr IntrinsicDummyArgument OptionalTEAM{"team", TEAM_TYPE,
+//    Rank::scalar, Optionality::optional, common::Intent::In};
+static constexpr IntrinsicDummyArgument RequiredTEAM{
+    "team", TEAM_TYPE, Rank::scalar, Optionality::required, common::Intent::In};
 
 struct IntrinsicInterface {
   static constexpr int maxArguments{7}; // if not a MAX/MIN(...)
@@ -739,6 +744,10 @@
     {"tan", {{"x", SameFloating}}, SameFloating},
     {"tand", {{"x", SameFloating}}, SameFloating},
     {"tanh", {{"x", SameFloating}}, SameFloating},
+    {"team_number", {}, DefaultInt, Rank::scalar,
+        IntrinsicClass::transformationalFunction},
+    {"team_number", {RequiredTEAM}, DefaultInt, Rank::scalar,
+        IntrinsicClass::transformationalFunction},
     {"tiny", {{"x", SameReal, Rank::anyOrAssumedRank}}, SameReal, Rank::scalar,
         IntrinsicClass::inquiryFunction},
     {"trailz", {{"i", AnyInt}}, DefaultInt},
@@ -1283,9 +1292,11 @@
     switch (d.typePattern.kindCode) {
     case KindCode::none:
     case KindCode::typeless:
-    case KindCode::teamType: // TODO: TEAM_TYPE
       argOk = false;
       break;
+    case KindCode::teamType: // TODO: TEAM_TYPE
+      argOk = type->category() == TypeCategory::Derived;
+      break;
     case KindCode::defaultIntegerKind:
       argOk = type->kind() == defaults.GetDefaultKind(TypeCategory::Integer);
       break;
Index: flang/docs/Intrinsics.md
===================================================================
--- flang/docs/Intrinsics.md
+++ flang/docs/Intrinsics.md
@@ -746,7 +746,7 @@
 
 | Intrinsic Category | Intrinsic Procedures Lacking Support |
 | --- | --- |
-| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE, COSHAPE |
+| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, STOPPED_IMAGES, 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 |


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D100897.339011.patch
Type: text/x-patch
Size: 4398 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210420/b307110b/attachment.bin>