diff options
Diffstat (limited to 'gcc/fortran/primary.cc')
| -rw-r--r-- | gcc/fortran/primary.cc | 35 |
1 files changed, 28 insertions, 7 deletions
diff --git a/gcc/fortran/primary.cc b/gcc/fortran/primary.cc index 0722c76d..1dcb1c3 100644 --- a/gcc/fortran/primary.cc +++ b/gcc/fortran/primary.cc @@ -3835,6 +3835,9 @@ gfc_match_rvalue (gfc_expr **result) gfc_typespec *ts; bool implicit_char; gfc_ref *ref; + gfc_symtree *pdt_st; + gfc_symbol *found_specific = NULL; + m = gfc_match ("%%loc"); if (m == MATCH_YES) @@ -4082,22 +4085,36 @@ gfc_match_rvalue (gfc_expr **result) break; } + gfc_gobble_whitespace (); + found_specific = NULL; + + /* Even if 'name' is that of a PDT template, priority has to be given to + possible specific procedures in the generic interface. */ + gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st); + if (sym->generic && sym->generic->next + && gfc_peek_ascii_char() != '(') + { + gfc_actual_arglist *arg = actual_arglist; + for (; arg && pdt_st; arg = arg->next) + gfc_resolve_expr (arg->expr); + found_specific = gfc_search_interface (sym->generic, 0, + &actual_arglist); + } + /* Check to see if this is a PDT constructor. The format of these constructors is rather unusual: name [(type_params)](component_values) where, component_values excludes the type_params. With the present gfortran representation this is rather awkward because the two are not distinguished, other than by their attributes. */ - if (sym->attr.generic) + if (sym->attr.generic && pdt_st != NULL && found_specific == NULL) { - gfc_symtree *pdt_st; gfc_symbol *pdt_sym; gfc_actual_arglist *ctr_arglist = NULL, *tmp; gfc_component *c; - /* Obtain the template. */ - gfc_find_sym_tree (gfc_dt_upper_string (name), NULL, 1, &pdt_st); - if (pdt_st && pdt_st->n.sym && pdt_st->n.sym->attr.pdt_template) + /* Use the template. */ + if (pdt_st->n.sym && pdt_st->n.sym->attr.pdt_template) { bool type_spec_list = false; pdt_sym = pdt_st->n.sym; @@ -4155,8 +4172,12 @@ gfc_match_rvalue (gfc_expr **result) tmp = tmp->next; } - gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name), - NULL, 1, &symtree); + if (found_specific) + gfc_find_sym_tree (found_specific->name, + NULL, 1, &symtree); + else + gfc_find_sym_tree (gfc_dt_lower_string (pdt_sym->name), + NULL, 1, &symtree); if (!symtree) { gfc_get_ha_sym_tree (gfc_dt_lower_string (pdt_sym->name) , |