diff options
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/interface.c | 86 |
2 files changed, 44 insertions, 48 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 122f6c689c9..35f970ead81 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2013-08-23 Janus Weil <janus@gcc.gnu.org> + + PR fortran/57843 + * interface.c (gfc_extend_assign): Look for type-bound assignment + procedures before non-typebound. + 2013-08-23 Mikael Morin <mikael@gcc.gnu.org> * trans-array.c (gfc_conv_section_startstride): Move &loop->pre access diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 9055cf538f1..aa88b3c3fa6 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -3754,20 +3754,18 @@ gfc_extend_expr (gfc_expr *e) } -/* Tries to replace an assignment code node with a subroutine call to - the subroutine associated with the assignment operator. Return - true if the node was replaced. On false, no error is - generated. */ +/* Tries to replace an assignment code node with a subroutine call to the + subroutine associated with the assignment operator. Return true if the node + was replaced. On false, no error is generated. */ bool gfc_extend_assign (gfc_code *c, gfc_namespace *ns) { gfc_actual_arglist *actual; - gfc_expr *lhs, *rhs; - gfc_symbol *sym; - const char *gname; - - gname = NULL; + gfc_expr *lhs, *rhs, *tb_base; + gfc_symbol *sym = NULL; + const char *gname = NULL; + gfc_typebound_proc* tbo; lhs = c->expr1; rhs = c->expr2; @@ -3785,8 +3783,26 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) actual->next = gfc_get_actual_arglist (); actual->next->expr = rhs; - sym = NULL; + /* TODO: Ambiguity-check, see above for gfc_extend_expr. */ + + /* See if we find a matching type-bound assignment. */ + tbo = matching_typebound_op (&tb_base, actual, INTRINSIC_ASSIGN, + NULL, &gname); + + if (tbo) + { + /* Success: Replace the expression with a type-bound call. */ + gcc_assert (tb_base); + c->expr1 = gfc_get_expr (); + build_compcall_for_operator (c->expr1, actual, tb_base, tbo, gname); + c->expr1->value.compcall.assign = 1; + c->expr1->where = c->loc; + c->expr2 = NULL; + c->op = EXEC_COMPCALL; + return true; + } + /* See if we find an 'ordinary' (non-typebound) assignment procedure. */ for (; ns; ns = ns->parent) { sym = gfc_search_interface (ns->op[INTRINSIC_ASSIGN], 1, &actual); @@ -3794,47 +3810,21 @@ gfc_extend_assign (gfc_code *c, gfc_namespace *ns) break; } - /* TODO: Ambiguity-check, see above for gfc_extend_expr. */ - - if (sym == NULL) + if (sym) { - gfc_typebound_proc* tbo; - gfc_expr* tb_base; - - /* See if we find a matching type-bound assignment. */ - tbo = matching_typebound_op (&tb_base, actual, - INTRINSIC_ASSIGN, NULL, &gname); - - /* If there is one, replace the expression with a call to it and - succeed. */ - if (tbo) - { - gcc_assert (tb_base); - c->expr1 = gfc_get_expr (); - build_compcall_for_operator (c->expr1, actual, tb_base, tbo, gname); - c->expr1->value.compcall.assign = 1; - c->expr1->where = c->loc; - c->expr2 = NULL; - c->op = EXEC_COMPCALL; - - /* c is resolved from the caller, so no need to do it here. */ - - return true; - } - - free (actual->next); - free (actual); - return false; + /* Success: Replace the assignment with the call. */ + c->op = EXEC_ASSIGN_CALL; + c->symtree = gfc_find_sym_in_symtree (sym); + c->expr1 = NULL; + c->expr2 = NULL; + c->ext.actual = actual; + return true; } - /* Replace the assignment with the call. */ - c->op = EXEC_ASSIGN_CALL; - c->symtree = gfc_find_sym_in_symtree (sym); - c->expr1 = NULL; - c->expr2 = NULL; - c->ext.actual = actual; - - return true; + /* Failure: No assignment procedure found. */ + free (actual->next); + free (actual); + return false; } |