PR fortran/18918
* array.c (gfc_match_array_ref): Better error message for
coarrays with too few ranks.
(match_subscript): Move one diagnostic to caller.
* gfortran.h (gfc_get_corank): Add prottype.
* expr.c (gfc_get_corank): New function.
* iresolve.c (resolve_bound): Fix rank for cobounds.
(gfc_resolve_lbound,gfc_resolve_lcobound, gfc_resolve_ubound,
gfc_resolve_ucobound, gfc_resolve_this_image): Update
resolve_bound call.
2010-07-08 Tobias Burnus <burnus@net-b.de>
PR fortran/18918
* gfortran.dg/coarray_10.f90: Add an additional test.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@161960
138bc75d-0d04-0410-961f-
82ee72b054a4
+2010-07-08 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * array.c (gfc_match_array_ref): Better error message for
+ coarrays with too few ranks.
+ (match_subscript): Move one diagnostic to caller.
+ * gfortran.h (gfc_get_corank): Add prottype.
+ * expr.c (gfc_get_corank): New function.
+ * iresolve.c (resolve_bound): Fix rank for cobounds.
+ (gfc_resolve_lbound,gfc_resolve_lcobound, gfc_resolve_ubound,
+ gfc_resolve_ucobound, gfc_resolve_this_image): Update
+ resolve_bound call.
+
2010-07-06 Tobias Burnus <burnus@net-b.de>
PR fortran/44742
else if (!star)
m = gfc_match_expr (&ar->start[i]);
- if (m == MATCH_NO)
+ if (m == MATCH_NO && gfc_match_char ('*') == MATCH_YES)
+ return MATCH_NO;
+ else if (m == MATCH_NO)
gfc_error ("Expected array subscript at %C");
if (m != MATCH_YES)
return MATCH_ERROR;
if (gfc_match_char (']') == MATCH_YES)
{
ar->codimen++;
+ if (ar->codimen < corank)
+ {
+ gfc_error ("Too few codimensions at %C, expected %d not %d",
+ corank, ar->codimen);
+ return MATCH_ERROR;
+ }
return MATCH_YES;
}
if (gfc_match_char (',') != MATCH_YES)
{
- gfc_error ("Invalid form of coarray reference at %C");
+ if (gfc_match_char ('*') == MATCH_YES)
+ gfc_error ("Unexpected '*' for codimension %d of %d at %C",
+ ar->codimen + 1, corank);
+ else
+ gfc_error ("Invalid form of coarray reference at %C");
+ return MATCH_ERROR;
+ }
+ if (ar->codimen >= corank)
+ {
+ gfc_error ("Invalid codimension %d at %C, only %d codimensions exist",
+ ar->codimen + 1, corank);
return MATCH_ERROR;
}
}
}
+bool
+gfc_get_corank (gfc_expr *e)
+{
+ int corank;
+ gfc_ref *ref;
+ corank = e->symtree->n.sym->as ? e->symtree->n.sym->as->corank : 0;
+ for (ref = e->ref; ref; ref = ref->next)
+ {
+ if (ref->type == REF_ARRAY)
+ corank = ref->u.ar.as->corank;
+ gcc_assert (ref->type != REF_SUBSTRING);
+ }
+ return corank;
+}
+
+
/* Check whether the expression has an ultimate allocatable component.
Being itself allocatable does not count. */
bool
bool gfc_is_proc_ptr_comp (gfc_expr *, gfc_component **);
bool gfc_is_coindexed (gfc_expr *);
+bool gfc_get_corank (gfc_expr *);
bool gfc_has_ultimate_allocatable (gfc_expr *);
bool gfc_has_ultimate_pointer (gfc_expr *);
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)
{
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);
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);
}
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);
}
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);
}
+2010-07-08 Tobias Burnus <burnus@net-b.de>
+
+ PR fortran/18918
+ * gfortran.dg/coarray_10.f90: Add an additional test.
+
2010-07-08 Peter Bergner <bergner@vnet.ibm.com>
PR middle-end/44828
j = this_image(dim=3) ! { dg-error "DIM argument without ARRAY argument" }
i = image_index(i, [ 1 ]) ! { dg-error "Expected coarray variable" }
i = image_index(z, 2) ! { dg-error "must be a rank one array" }
-
end subroutine this_image_check
+
+
+subroutine rank_mismatch()
+ implicit none
+ integer,allocatable :: A(:)[:,:,:,:]
+ allocate(A(1)[1,1,1:*]) ! { dg-error "Unexpected ... for codimension" }
+ allocate(A(1)[1,1,1,1,1,*]) ! { dg-error "Invalid codimension 5" }
+ allocate(A(1)[1,1,1,*])
+ allocate(A(1)[1,1]) ! { dg-error "Too few codimensions" }
+ allocate(A(1)[1,*]) ! { dg-error "Too few codimensions" }
+ allocate(A(1)[1,1:*]) ! { dg-error "Unexpected ... for codimension" }
+
+ A(1)[1,1,1] = 1 ! { dg-error "Too few codimensions" }
+ A(1)[1,1,1,1,1,1] = 1 ! { dg-error "Invalid codimension 5" }
+ A(1)[1,1,1,1] = 1
+ A(1)[1,1] = 1 ! { dg-error "Too few codimensions" }
+ A(1)[1,1] = 1 ! { dg-error "Too few codimensions" }
+ A(1)[1,1:1] = 1 ! { dg-error "Too few codimensions" }
+end subroutine rank_mismatch