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, COSHAPE | +| Coarray intrinsic functions | LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, STOPPED_IMAGES, 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 @@ -105,7 +105,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{ @@ -237,6 +237,8 @@ common::Intent::In}; static constexpr IntrinsicDummyArgument OptionalMASK{"mask", AnyLogical, Rank::conformable, 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(...) @@ -746,6 +748,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}, // optional team dummy arguments needed to complete the following // this_image versions {"this_image", {{"coarray", AnyData, Rank::coarray}, OptionalDIM}, @@ -825,7 +831,7 @@ // TODO: Coarray intrinsic functions // LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX, -// STOPPED_IMAGES, TEAM_NUMBER, COSHAPE +// STOPPED_IMAGES, COSHAPE // TODO: Non-standard intrinsic functions // AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT, // COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT, @@ -1293,9 +1299,12 @@ switch (d.typePattern.kindCode) { case KindCode::none: case KindCode::typeless: - case KindCode::teamType: // TODO: TEAM_TYPE argOk = false; break; + case KindCode::teamType: + argOk = type->GetDerivedTypeSpec().typeSymbol().name() == + "__builtin_team_type"; + break; case KindCode::defaultIntegerKind: argOk = type->kind() == defaults.GetDefaultKind(TypeCategory::Integer); break; @@ -1726,6 +1735,10 @@ CHECK(d.optionality != Optionality::required); if (d.typePattern.kindCode == KindCode::same) { dummyArgs.emplace_back(dummyArgs[sameDummyArg.value()]); + } else if (d.typePattern.kindCode == KindCode::teamType) { + common::die("INTERNAL: missing optional TEAM_TYPE dummy argument is " + "unimplemented"); + return std::nullopt; } else { auto category{d.typePattern.categorySet.LeastElement().value()}; characteristics::TypeAndShape typeAndShape{ Index: flang/test/Semantics/team_number.f90 =================================================================== --- /dev/null +++ flang/test/Semantics/team_number.f90 @@ -0,0 +1,21 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! 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/unittests/Evaluate/intrinsics.cpp =================================================================== --- flang/unittests/Evaluate/intrinsics.cpp +++ flang/unittests/Evaluate/intrinsics.cpp @@ -156,6 +156,8 @@ using Complex8 = Type; using Char = Type; using Log4 = Type; + // For testing team arguments (fails to compile) + // using Team = Type; TestCall{defaults, table, "bad"} .Push(Const(Scalar{})) @@ -294,6 +296,35 @@ .Push(Const(Scalar{})) .DoCall(); // bad type + TestCall{defaults, table, "team_number"}.DoCall(Int4::GetType()); + TestCall{defaults, table, "team_number"} + .Push(Const(Scalar{})) + .Push(Const(Scalar{})) + .DoCall(); // too many args + TestCall{defaults, table, "team_number"} + .Push(Named("bad", Const(Scalar{}))) + .DoCall(); // bad keyword + TestCall{defaults, table, "team_number"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "team_number"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "team_number"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "team_number"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + TestCall{defaults, table, "team_number"} + .Push(Const(Scalar{})) + .DoCall(); // bad type + + // TODO: test TEAM argument + // TestCall{defaults, table, "team_number"} + // .Push(Const(Scalar{})) + // .DoCall(Int4::GetType()); + // TODO: test other intrinsics // Test unrestricted specific to generic name mapping (table 16.2).