aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/iresolve.cc
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran/iresolve.cc')
-rw-r--r--gcc/fortran/iresolve.cc48
1 files changed, 37 insertions, 11 deletions
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index 858ffb1..6930e2c 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3209,17 +3209,28 @@ gfc_resolve_get_team (gfc_expr *f, gfc_expr *level ATTRIBUTE_UNUSED)
{
static char get_team[] = "_gfortran_caf_get_team";
f->rank = 0;
- f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+ f->ts.type = BT_DERIVED;
+ gfc_find_symbol ("team_type", gfc_current_ns, 1, &f->ts.u.derived);
+ if (!f->ts.u.derived
+ || f->ts.u.derived->from_intmod != INTMOD_ISO_FORTRAN_ENV)
+ {
+ gfc_error (
+ "GET_TEAM at %L needs USE of the intrinsic module ISO_FORTRAN_ENV "
+ "to define its result type TEAM_TYPE",
+ &f->where);
+ f->ts.type = BT_UNKNOWN;
+ }
f->value.function.name = get_team;
-}
+ /* No requirements to resolve for level argument now. */
+}
/* Resolve image_index (...). */
void
gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED,
- gfc_expr *sub ATTRIBUTE_UNUSED)
+ gfc_expr *sub ATTRIBUTE_UNUSED,
+ gfc_expr *team_or_team_number ATTRIBUTE_UNUSED)
{
static char image_index[] = "__image_index";
f->ts.type = BT_INTEGER;
@@ -3248,31 +3259,46 @@ gfc_resolve_stopped_images (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED,
/* Resolve team_number (team). */
void
-gfc_resolve_team_number (gfc_expr *f, gfc_expr *team ATTRIBUTE_UNUSED)
+gfc_resolve_team_number (gfc_expr *f, gfc_expr *team)
{
static char team_number[] = "_gfortran_caf_team_number";
f->rank = 0;
f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind;
f->value.function.name = team_number;
-}
+ if (team)
+ gfc_resolve_expr (team);
+}
void
-gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim,
- gfc_expr *distance ATTRIBUTE_UNUSED)
+gfc_resolve_this_image (gfc_expr *f, gfc_expr *coarray, gfc_expr *dim,
+ gfc_expr *team)
{
static char this_image[] = "__this_image";
- if (array && gfc_is_coarray (array))
- resolve_bound (f, array, dim, NULL, "__this_image", true);
+ if (coarray && dim)
+ resolve_bound (f, coarray, dim, NULL, this_image, true);
+ else if (coarray)
+ {
+ f->ts.type = BT_INTEGER;
+ f->ts.kind = gfc_default_integer_kind;
+ f->value.function.name = this_image;
+ if (f->shape && f->rank != 1)
+ gfc_free_shape (&f->shape, f->rank);
+ f->rank = 1;
+ f->shape = gfc_get_shape (1);
+ mpz_init_set_ui (f->shape[0], coarray->corank);
+ }
else
{
f->ts.type = BT_INTEGER;
f->ts.kind = gfc_default_integer_kind;
f->value.function.name = this_image;
}
-}
+ if (team)
+ gfc_resolve_expr (team);
+}
void
gfc_resolve_time (gfc_expr *f)