diff options
Diffstat (limited to 'gcc/fortran/iresolve.cc')
-rw-r--r-- | gcc/fortran/iresolve.cc | 48 |
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) |