diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 23 | ||||
| -rw-r--r-- | gcc/fortran/class.c | 13 | ||||
| -rw-r--r-- | gcc/fortran/decl.c | 38 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 13 |
4 files changed, 44 insertions, 43 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae8f661ff53..b5324f255fa 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,26 @@ +2016-11-13 Janus Weil <janus@gcc.gnu.org> + + PR fortran/60952 + * decl.c (match_procedure_in_type): Apply the FL_PROCEDURE attribute + to the target procedure. + +2016-11-13 Janus Weil <janus@gcc.gnu.org> + + PR fortran/66366 + * resolve.c (resolve_component): Move check for C437 + to ... + * decl.c (build_struct): ... here. Fix indentation. + +2016-11-12 Janus Weil <janus@gcc.gnu.org> + + PR fortran/77501 + * class.c (gfc_find_typebound_intrinsic_op): Remove an unnecessary + assert and nullification. + * decl.c (gfc_match_decl_type_spec): Use gfc_get_tbp_symtree, + fix indentation. + (gfc_match_generic): Remove an unnecessary assert. + Use gfc_get_tbp_symtree to avoid ICE. + 2016-11-10 Fritz O. Reese <fritzoreese@gmail.com> PR fortran/78277 diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c index b7f68d2f19a..b42ec40578f 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.c @@ -2963,15 +2963,6 @@ gfc_find_typebound_intrinsic_op (gfc_symbol* derived, bool* t, gfc_symtree* gfc_get_tbp_symtree (gfc_symtree **root, const char *name) { - gfc_symtree *result; - - result = gfc_find_symtree (*root, name); - if (!result) - { - result = gfc_new_symtree (root, name); - gcc_assert (result); - result->n.tb = NULL; - } - - return result; + gfc_symtree *result = gfc_find_symtree (*root, name); + return result ? result : gfc_new_symtree (root, name); } diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index bf6bc246709..21eaafe488f 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1866,9 +1866,18 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init, } else if (current_attr.allocatable == 0) { - gfc_error ("Component at %C must have the POINTER attribute"); - return false; + gfc_error ("Component at %C must have the POINTER attribute"); + return false; + } } + + /* F03:C437. */ + if (current_ts.type == BT_CLASS + && !(current_attr.pointer || current_attr.allocatable)) + { + gfc_error ("Component %qs with CLASS at %C must be allocatable " + "or pointer", name); + return false; } if (gfc_current_block ()->attr.pointer && (*as)->rank != 0) @@ -3198,13 +3207,11 @@ gfc_match_decl_type_spec (gfc_typespec *ts, int implicit_flag) upe->attr.zero_comp = 1; if (!gfc_add_flavor (&upe->attr, FL_DERIVED, NULL, &gfc_current_locus)) - return MATCH_ERROR; - } + return MATCH_ERROR; + } else { - st = gfc_find_symtree (gfc_current_ns->sym_root, "STAR"); - if (st == NULL) - st = gfc_new_symtree (&gfc_current_ns->sym_root, "STAR"); + st = gfc_get_tbp_symtree (&gfc_current_ns->sym_root, "STAR"); st->n.sym = upe; upe->refs++; } @@ -9617,6 +9624,8 @@ match_procedure_in_type (void) false)) return MATCH_ERROR; gfc_set_sym_referenced (stree->n.tb->u.specific->n.sym); + gfc_add_flavor(&stree->n.tb->u.specific->n.sym->attr, FL_PROCEDURE, + target, &stree->n.tb->u.specific->n.sym->declared_at); if (gfc_match_eos () == MATCH_YES) return MATCH_YES; @@ -9731,14 +9740,7 @@ gfc_match_generic (void) gfc_symtree* st; st = gfc_find_symtree (is_op ? ns->tb_uop_root : ns->tb_sym_root, name); - if (st) - { - tb = st->n.tb; - gcc_assert (tb); - } - else - tb = NULL; - + tb = st ? st->n.tb : NULL; break; } @@ -9783,10 +9785,8 @@ gfc_match_generic (void) case INTERFACE_USER_OP: { const bool is_op = (op_type == INTERFACE_USER_OP); - gfc_symtree* st; - - st = gfc_new_symtree (is_op ? &ns->tb_uop_root : &ns->tb_sym_root, - name); + gfc_symtree* st = gfc_get_tbp_symtree (is_op ? &ns->tb_uop_root : + &ns->tb_sym_root, name); gcc_assert (st); st->n.tb = tb; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index faf7dde4183..c85525aabb9 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -13587,19 +13587,6 @@ resolve_component (gfc_component *c, gfc_symbol *sym) return false; } - /* C437. */ - if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE - && (!c->attr.class_ok - || !(CLASS_DATA (c)->attr.class_pointer - || CLASS_DATA (c)->attr.allocatable))) - { - gfc_error ("Component %qs with CLASS at %L must be allocatable " - "or pointer", c->name, &c->loc); - /* Prevent a recurrence of the error. */ - c->ts.type = BT_UNKNOWN; - return false; - } - /* If an allocatable component derived type is of the same type as the enclosing derived type, we need a vtable generating so that the __deallocate procedure is created. */ |