| Message ID | CAKwh3qhiLw+Qg0DUNOVW0NcdEsoecVEF_FdNsMNbCgB5o5JJag@mail.gmail.com |
|---|---|
| State | New |
| Headers | show |
Janus Weil wrote: > the attached patch fixes this accepts-valid OOP PR. It consists of two parts: > 1) resolve_structure_cons is being extended to check the interface of > proc-ptr components (comment #7). > 2) A small fix to allow for correct parsing of structure constructors > including proc-ptr components (comment #8). Thanks for the patch! > + if (s2&& !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1, > + err, sizeof(err))) Space after sizeof. > + gfc_error ("In derived type constructor at %L: Interface mismatch" > + " in procedure pointer component '%s': %s", > + &cons->expr->where, comp->name, err); Somehow, I find the words clumsy with too many colons. "derived type constructor" - I'd use a hyphen ("derived-type") and I want to note that the standard calls it "structure constructor"; I also would use "for ... component" and not "in ... component" and add a hyphen to "procedure pointer". How about a simpler: "Interface mismatch for procedure-pointer component '%s' at %L: %s"? I think it should be clear from the context that it is about a structure constructor. Or for the long version, how about: "Interface mismatch for procedure-pointer component '%s' in structure constructor at %L: %s"? OK with fixing the sizeof nit and after considering the text changes. Tobias
Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 178634) +++ gcc/fortran/resolve.c (working copy) @@ -1119,6 +1119,40 @@ resolve_structure_cons (gfc_expr *expr, int init) comp->name); } + if (comp->attr.proc_pointer && comp->ts.interface) + { + /* Check procedure pointer interface. */ + gfc_symbol *s2 = NULL; + gfc_component *c2; + const char *name; + char err[200]; + + if (gfc_is_proc_ptr_comp (cons->expr, &c2)) + { + s2 = c2->ts.interface; + name = c2->name; + } + else if (cons->expr->expr_type == EXPR_FUNCTION) + { + s2 = cons->expr->symtree->n.sym->result; + name = cons->expr->symtree->n.sym->result->name; + } + else if (cons->expr->expr_type != EXPR_NULL) + { + s2 = cons->expr->symtree->n.sym; + name = cons->expr->symtree->n.sym->name; + } + + if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1, + err, sizeof(err))) + { + gfc_error ("In derived type constructor at %L: Interface mismatch" + " in procedure pointer component '%s': %s", + &cons->expr->where, comp->name, err); + return FAILURE; + } + } + if (!comp->attr.pointer || comp->attr.proc_pointer || cons->expr->expr_type == EXPR_NULL) continue; Index: gcc/fortran/primary.c =================================================================== --- gcc/fortran/primary.c (revision 178634) +++ gcc/fortran/primary.c (working copy) @@ -2418,7 +2418,10 @@ gfc_match_structure_constructor (gfc_symbol *sym, } /* Match the current initializer expression. */ + if (this_comp->attr.proc_pointer) + gfc_matching_procptr_assignment = 1; m = gfc_match_expr (&comp_tail->val); + gfc_matching_procptr_assignment = 0; if (m == MATCH_NO) goto syntax; if (m == MATCH_ERROR)