Message ID | CAKwh3qgF=J+qjWZto850vNehGaF9yyUODBqtr2-9WFv=1RRfjQ@mail.gmail.com |
---|---|
State | New |
Headers | show |
ping! 2017-03-29 22:25 GMT+02:00 Janus Weil <janus@gcc.gnu.org>: > Hi all, > > here is a patch that enhances the diagnostics for procedure-pointer > assignments, so that procedure-pointer components that need an > explicit interface are correctly rejected. > > Regtests cleanly on x86_64-linux-gnu. Ok for trunk? > > Cheers, > Janus > > > 2017-03-29 Janus Weil <janus@gcc.gnu.org> > > PR fortran/80046 > * expr.c (gfc_check_pointer_assign): Check if procedure pointer > components in a pointer assignment need an explicit interface. > > 2017-03-29 Janus Weil <janus@gcc.gnu.org> > > PR fortran/80046 > * gfortran.dg/proc_ptr_comp_48.f90: New test case.
Hi Janus, The patch is OK for trunk. Thanks Paul On 7 April 2017 at 17:51, Janus Weil <janus@gcc.gnu.org> wrote: > ping! > > 2017-03-29 22:25 GMT+02:00 Janus Weil <janus@gcc.gnu.org>: >> Hi all, >> >> here is a patch that enhances the diagnostics for procedure-pointer >> assignments, so that procedure-pointer components that need an >> explicit interface are correctly rejected. >> >> Regtests cleanly on x86_64-linux-gnu. Ok for trunk? >> >> Cheers, >> Janus >> >> >> 2017-03-29 Janus Weil <janus@gcc.gnu.org> >> >> PR fortran/80046 >> * expr.c (gfc_check_pointer_assign): Check if procedure pointer >> components in a pointer assignment need an explicit interface. >> >> 2017-03-29 Janus Weil <janus@gcc.gnu.org> >> >> PR fortran/80046 >> * gfortran.dg/proc_ptr_comp_48.f90: New test case.
Thanks, Paul. Committed as r246823. Cheers, Janus 2017-04-09 12:40 GMT+02:00 Paul Richard Thomas <paul.richard.thomas@gmail.com>: > Hi Janus, > > The patch is OK for trunk. > > Thanks > > Paul > > > On 7 April 2017 at 17:51, Janus Weil <janus@gcc.gnu.org> wrote: >> ping! >> >> 2017-03-29 22:25 GMT+02:00 Janus Weil <janus@gcc.gnu.org>: >>> Hi all, >>> >>> here is a patch that enhances the diagnostics for procedure-pointer >>> assignments, so that procedure-pointer components that need an >>> explicit interface are correctly rejected. >>> >>> Regtests cleanly on x86_64-linux-gnu. Ok for trunk? >>> >>> Cheers, >>> Janus >>> >>> >>> 2017-03-29 Janus Weil <janus@gcc.gnu.org> >>> >>> PR fortran/80046 >>> * expr.c (gfc_check_pointer_assign): Check if procedure pointer >>> components in a pointer assignment need an explicit interface. >>> >>> 2017-03-29 Janus Weil <janus@gcc.gnu.org> >>> >>> PR fortran/80046 >>> * gfortran.dg/proc_ptr_comp_48.f90: New test case. > > > > -- > "If you can't explain it simply, you don't understand it well enough" > - Albert Einstein
Index: gcc/fortran/expr.c =================================================================== --- gcc/fortran/expr.c (revision 246573) +++ gcc/fortran/expr.c (working copy) @@ -3595,25 +3595,41 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex return false; } - if (s1 == s2 || !s1 || !s2) - return true; - /* F08:7.2.2.4 (4) */ - if (s1->attr.if_source == IFSRC_UNKNOWN - && gfc_explicit_interface_required (s2, err, sizeof(err))) + if (s2 && gfc_explicit_interface_required (s2, err, sizeof(err))) { - gfc_error ("Explicit interface required for %qs at %L: %s", - s1->name, &lvalue->where, err); - return false; + if (comp1 && !s1) + { + gfc_error ("Explicit interface required for component %qs at %L: %s", + comp1->name, &lvalue->where, err); + return false; + } + else if (s1->attr.if_source == IFSRC_UNKNOWN) + { + gfc_error ("Explicit interface required for %qs at %L: %s", + s1->name, &lvalue->where, err); + return false; + } } - if (s2->attr.if_source == IFSRC_UNKNOWN - && gfc_explicit_interface_required (s1, err, sizeof(err))) + if (s1 && gfc_explicit_interface_required (s1, err, sizeof(err))) { - gfc_error ("Explicit interface required for %qs at %L: %s", - s2->name, &rvalue->where, err); - return false; + if (comp2 && !s2) + { + gfc_error ("Explicit interface required for component %qs at %L: %s", + comp2->name, &rvalue->where, err); + return false; + } + else if (s2->attr.if_source == IFSRC_UNKNOWN) + { + gfc_error ("Explicit interface required for %qs at %L: %s", + s2->name, &rvalue->where, err); + return false; + } } + if (s1 == s2 || !s1 || !s2) + return true; + if (!gfc_compare_interfaces (s1, s2, name, 0, 1, err, sizeof(err), NULL, NULL)) {