diff options
Diffstat (limited to 'gcc/fortran/check.c')
| -rw-r--r-- | gcc/fortran/check.c | 40 |
1 files changed, 39 insertions, 1 deletions
diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index dec431bc2e..3196420b45 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -399,7 +399,15 @@ less_than_bitsize2 (const char *arg1, gfc_expr *expr1, const char *arg2, static bool same_type_check (gfc_expr *e, int n, gfc_expr *f, int m) { - if (gfc_compare_types (&e->ts, &f->ts)) + gfc_typespec *ets = &e->ts; + gfc_typespec *fts = &f->ts; + + if (e->ts.type == BT_PROCEDURE && e->symtree->n.sym) + ets = &e->symtree->n.sym->ts; + if (f->ts.type == BT_PROCEDURE && f->symtree->n.sym) + fts = &f->symtree->n.sym->ts; + + if (gfc_compare_types (ets, fts)) return true; gfc_error ("%qs argument of %qs intrinsic at %L must be the same type " @@ -3711,6 +3719,36 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, } } } + else if (shape->expr_type == EXPR_VARIABLE && shape->ref + && shape->ref->u.ar.type == AR_FULL && shape->ref->u.ar.dimen == 1 + && shape->ref->u.ar.as + && shape->ref->u.ar.as->lower[0]->expr_type == EXPR_CONSTANT + && shape->ref->u.ar.as->lower[0]->ts.type == BT_INTEGER + && shape->ref->u.ar.as->upper[0]->expr_type == EXPR_CONSTANT + && shape->ref->u.ar.as->upper[0]->ts.type == BT_INTEGER + && shape->symtree->n.sym->attr.flavor == FL_PARAMETER) + { + int i, extent; + gfc_expr *e, *v; + + v = shape->symtree->n.sym->value; + + for (i = 0; i < shape_size; i++) + { + e = gfc_constructor_lookup_expr (v->value.constructor, i); + if (e == NULL) + break; + + gfc_extract_int (e, &extent); + + if (extent < 0) + { + gfc_error ("Element %d of actual argument of RESHAPE at %L " + "cannot be negative", i + 1, &shape->where); + return false; + } + } + } if (pad != NULL) { |