diff options
Diffstat (limited to 'gcc/fortran/iresolve.c')
| -rw-r--r-- | gcc/fortran/iresolve.c | 31 |
1 files changed, 22 insertions, 9 deletions
diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index 8f764ef9083..9bf767dbaf6 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -122,7 +122,7 @@ resolve_mask_arg (gfc_expr *mask) static void resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind, - const char *name) + const char *name, bool coarray) { f->ts.type = BT_INTEGER; if (kind) @@ -134,7 +134,8 @@ resolve_bound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind, { f->rank = 1; f->shape = gfc_get_shape (1); - mpz_init_set_ui (f->shape[0], array->rank); + mpz_init_set_ui (f->shape[0], coarray ? gfc_get_corank (array) + : array->rank); } f->value.function.name = xstrdup (name); @@ -853,7 +854,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) gfc_add_component_ref (a, "$vptr"); else if (a->ts.type == BT_DERIVED) { - vtab = gfc_find_derived_vtab (a->ts.u.derived, false); + vtab = gfc_find_derived_vtab (a->ts.u.derived); /* Clear the old expr. */ gfc_free_ref_list (a->ref); memset (a, '\0', sizeof (gfc_expr)); @@ -869,7 +870,7 @@ gfc_resolve_extends_type_of (gfc_expr *f, gfc_expr *a, gfc_expr *mo) gfc_add_component_ref (mo, "$vptr"); else if (mo->ts.type == BT_DERIVED) { - vtab = gfc_find_derived_vtab (mo->ts.u.derived, false); + vtab = gfc_find_derived_vtab (mo->ts.u.derived); /* Clear the old expr. */ gfc_free_ref_list (mo->ref); memset (mo, '\0', sizeof (gfc_expr)); @@ -1268,14 +1269,14 @@ gfc_resolve_kill (gfc_expr *f, gfc_expr *p ATTRIBUTE_UNUSED, void gfc_resolve_lbound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - resolve_bound (f, array, dim, kind, "__lbound"); + resolve_bound (f, array, dim, kind, "__lbound", false); } void gfc_resolve_lcobound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - resolve_bound (f, array, dim, kind, "__lcobound"); + resolve_bound (f, array, dim, kind, "__lcobound", true); } @@ -2318,6 +2319,18 @@ gfc_resolve_ftell (gfc_expr *f, gfc_expr *u) void +gfc_resolve_storage_size (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED, + gfc_expr *kind) +{ + f->ts.type = BT_INTEGER; + if (kind) + f->ts.kind = mpz_get_si (kind->value.integer); + else + f->ts.kind = gfc_default_integer_kind; +} + + +void gfc_resolve_sum (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { const char *name; @@ -2401,7 +2414,7 @@ gfc_resolve_image_index (gfc_expr *f, gfc_expr *array ATTRIBUTE_UNUSED, void gfc_resolve_this_image (gfc_expr *f, gfc_expr *array, gfc_expr *dim) { - resolve_bound (f, array, dim, NULL, "__this_image"); + resolve_bound (f, array, dim, NULL, "__this_image", true); } @@ -2540,14 +2553,14 @@ gfc_resolve_trim (gfc_expr *f, gfc_expr *string) void gfc_resolve_ubound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - resolve_bound (f, array, dim, kind, "__ubound"); + resolve_bound (f, array, dim, kind, "__ubound", false); } void gfc_resolve_ucobound (gfc_expr *f, gfc_expr *array, gfc_expr *dim, gfc_expr *kind) { - resolve_bound (f, array, dim, kind, "__ucobound"); + resolve_bound (f, array, dim, kind, "__ucobound", true); } |