[flang-commits] [flang] 81f8ad1 - [flang] Make 'this_image()' an intrinsic function
Craig Rasmussen via flang-commits
flang-commits at lists.llvm.org
Tue Sep 14 16:41:10 PDT 2021
Author: Craig Rasmussen
Date: 2021-09-14T16:40:08-07:00
New Revision: 81f8ad1769665a569a235b749e0e9e69ce7dc65e
URL: https://github.com/llvm/llvm-project/commit/81f8ad1769665a569a235b749e0e9e69ce7dc65e
DIFF: https://github.com/llvm/llvm-project/commit/81f8ad1769665a569a235b749e0e9e69ce7dc65e.diff
LOG: [flang] Make 'this_image()' an intrinsic function
Added 'this_image()' to the list of functions that are evaluated as intrinsic.
Added IsCoarray functions to determine if an expression is a coarray (corank > 1).
Added save attribute to coarray variables in test file, this_image.f90.
reviewers: klausler, PeteSteinfeld
Differential Revision: https://reviews.llvm.org/D108059
Added:
flang/test/Semantics/this_image.f90
Modified:
flang/docs/Intrinsics.md
flang/include/flang/Evaluate/tools.h
flang/lib/Evaluate/intrinsics.cpp
flang/lib/Evaluate/tools.cpp
flang/test/Semantics/call10.f90
Removed:
################################################################################
diff --git a/flang/docs/Intrinsics.md b/flang/docs/Intrinsics.md
index 5b353e89311ad..f8f335f9d4dae 100644
--- a/flang/docs/Intrinsics.md
+++ b/flang/docs/Intrinsics.md
@@ -746,7 +746,7 @@ This phase currently supports all the intrinsic procedures listed above but the
| 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, TEAM_NUMBER, 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/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index a70f5f2b2f847..2c6ac4207598e 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -89,6 +89,23 @@ template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
return x && IsAssumedRank(*x);
}
+// Predicate: true when an expression is a coarray (corank > 0)
+bool IsCoarray(const ActualArgument &);
+template <typename A> bool IsCoarray(const A &) { return false; }
+template <typename A> bool IsCoarray(const Designator<A> &designator) {
+ if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
+ return IsCoarray(symbol->get());
+ } else {
+ return false;
+ }
+}
+template <typename T> bool IsCoarray(const Expr<T> &expr) {
+ return std::visit([](const auto &x) { return IsCoarray(x); }, expr.u);
+}
+template <typename A> bool IsCoarray(const std::optional<A> &x) {
+ return x && IsCoarray(*x);
+}
+
// Generalizing packagers: these take operations and expressions of more
// specific types and wrap them in Expr<> containers of more abstract types.
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 15421a205d3d7..59d6517338d5a 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -16,6 +16,7 @@
#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/tools.h"
#include "flang/Evaluate/type.h"
+#include "flang/Semantics/tools.h"
#include "llvm/Support/raw_ostream.h"
#include <algorithm>
#include <map>
@@ -176,6 +177,7 @@ ENUM_CLASS(Rank,
shape, // INTEGER vector of known length and no negative element
matrix,
array, // not scalar, rank is known and greater than zero
+ coarray, // rank is known and can be scalar; has nonzero corank
known, // rank is known and can be scalar
anyOrAssumedRank, // rank can be unknown; assumed-type TYPE(*) allowed
conformable, // scalar, or array of same rank & shape as "array" argument
@@ -741,6 +743,12 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{"tan", {{"x", SameFloating}}, SameFloating},
{"tand", {{"x", SameFloating}}, SameFloating},
{"tanh", {{"x", SameFloating}}, SameFloating},
+ // optional team dummy arguments needed to complete the following
+ // this_image versions
+ {"this_image", {{"coarray", AnyData, Rank::coarray}, OptionalDIM},
+ DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ {"this_image", {}, DefaultInt, Rank::scalar,
+ IntrinsicClass::transformationalFunction},
{"tiny", {{"x", SameReal, Rank::anyOrAssumedRank}}, SameReal, Rank::scalar,
IntrinsicClass::inquiryFunction},
{"trailz", {{"i", AnyInt}}, DefaultInt},
@@ -814,8 +822,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
// TODO: Coarray intrinsic functions
// LCOBOUND, UCOBOUND, FAILED_IMAGES, GET_TEAM, IMAGE_INDEX,
-// STOPPED_IMAGES, TEAM_NUMBER, THIS_IMAGE,
-// COSHAPE
+// STOPPED_IMAGES, TEAM_NUMBER, COSHAPE
// TODO: Non-standard intrinsic functions
// AND, OR, XOR, LSHIFT, RSHIFT, SHIFT, ZEXT, IZEXT,
// COMPL, EQV, NEQV, INT8, JINT, JNINT, KNINT,
@@ -1420,6 +1427,15 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
argOk &= rank == arrayArg->Rank();
}
break;
+ case Rank::coarray:
+ argOk = IsCoarray(*arg);
+ if (!argOk) {
+ messages.Say(
+ "'coarray=' argument must have corank > 0 for intrinsic '%s'"_err_en_US,
+ name);
+ return std::nullopt;
+ }
+ break;
case Rank::known:
if (!knownArg) {
knownArg = arg;
@@ -1634,6 +1650,7 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
case Rank::elementalOrBOZ:
case Rank::shape:
case Rank::array:
+ case Rank::coarray:
case Rank::known:
case Rank::anyOrAssumedRank:
case Rank::reduceOperation:
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 122502123f038..eb337cb8aa765 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -683,6 +683,14 @@ bool IsAssumedRank(const ActualArgument &arg) {
}
}
+bool IsCoarray(const ActualArgument &arg) {
+ if (const auto *expr{arg.UnwrapExpr()}) {
+ return IsCoarray(*expr);
+ } else {
+ return false;
+ }
+}
+
bool IsProcedure(const Expr<SomeType> &expr) {
return std::holds_alternative<ProcedureDesignator>(expr.u);
}
diff --git a/flang/test/Semantics/call10.f90 b/flang/test/Semantics/call10.f90
index deb6e373013bb..fabadad32f1a1 100644
--- a/flang/test/Semantics/call10.f90
+++ b/flang/test/Semantics/call10.f90
@@ -184,7 +184,6 @@ pure subroutine s13
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()
nimgs = num_images()
i = img ! i is ready to use
diff --git a/flang/test/Semantics/this_image.f90 b/flang/test/Semantics/this_image.f90
new file mode 100644
index 0000000000000..089ab15768a30
--- /dev/null
+++ b/flang/test/Semantics/this_image.f90
@@ -0,0 +1,22 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Check for semantic errors in this_image() function calls
+
+subroutine test
+ use, intrinsic :: iso_fortran_env, only: team_type
+ type(team_type) :: oregon, coteam[*]
+ integer :: coscalar[*], coarray(3)[*]
+ save :: coteam, coscalar, coarray
+
+ ! correct calls, should produce no errors
+ print *, this_image()
+ print *, this_image(coarray)
+ print *, this_image(coscalar,1)
+ print *, this_image(coarray,1)
+
+ !ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'this_image'
+ print *, this_image(array,1)
+
+ ! TODO: More complete testing requires implementation of team_type
+ ! actual arguments in flang/lib/Evaluate/intrinsics.cpp
+
+end subroutine
More information about the flang-commits
mailing list