diff options
Diffstat (limited to 'gcc/fortran/expr.c')
| -rw-r--r-- | gcc/fortran/expr.c | 29 |
1 files changed, 23 insertions, 6 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c index c876fdd7740..cb7305ecf5a 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.c @@ -215,7 +215,7 @@ gfc_get_int_expr (int kind, locus *where, int value) p = gfc_get_constant_expr (BT_INTEGER, kind, where ? where : &gfc_current_locus); - mpz_init_set_si (p->value.integer, value); + mpz_set_si (p->value.integer, value); return p; } @@ -1894,7 +1894,7 @@ gfc_simplify_expr (gfc_expr *p, int type) if (p->expr_type == EXPR_ARRAY && p->ref && p->ref->type == REF_ARRAY && p->ref->u.ar.type == AR_FULL) - gfc_expand_constructor (p); + gfc_expand_constructor (p, false); if (simplify_const_ref (p) == FAILURE) return FAILURE; @@ -2573,7 +2573,7 @@ check_init_expr (gfc_expr *e) if (t == FAILURE) break; - t = gfc_expand_constructor (e); + t = gfc_expand_constructor (e, true); if (t == FAILURE) break; @@ -2609,7 +2609,7 @@ gfc_reduce_init_expr (gfc_expr *expr) { if (gfc_check_constructor_type (expr) == FAILURE) return FAILURE; - if (gfc_expand_constructor (expr) == FAILURE) + if (gfc_expand_constructor (expr, true) == FAILURE) return FAILURE; } @@ -3306,7 +3306,8 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue) } if (!pointer && !proc_pointer - && !(lvalue->ts.type == BT_CLASS && CLASS_DATA (lvalue)->attr.pointer)) + && !(lvalue->ts.type == BT_CLASS + && CLASS_DATA (lvalue)->attr.class_pointer)) { gfc_error ("Pointer assignment to non-POINTER at %L", &lvalue->where); return FAILURE; @@ -3543,7 +3544,7 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_expr *rvalue) lvalue.where = sym->declared_at; if (sym->attr.pointer || sym->attr.proc_pointer - || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.pointer + || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.class_pointer && rvalue->expr_type == EXPR_NULL)) r = gfc_check_pointer_assign (&lvalue, rvalue); else @@ -4022,6 +4023,22 @@ gfc_is_coindexed (gfc_expr *e) } +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 |