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 | 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/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