| Message ID | 20190812223224.GA43857@troutmask.apl.washington.edu |
|---|---|
| State | New |
| Headers | show |
| Series | PR fortran/89647 -- Allow host associated procedure to be a binding target | expand |
On Tue, Aug 13, 2019 at 1:32 AM Steve Kargl <sgk@troutmask.apl.washington.edu> wrote: > > The attached patch fixes PR fortran/89647, and has been > regression tested on x86_64-*-freebsd. > > If a procedure is made accessible by host association, the > that procedure can be used as binding target. During the > resolution of a type bound procedure, gfortran needs to > check the parent namespace for a procedure before it fails. > > 2019-08-12 Steven G. Kargl <kargl@gcc.gnu.org> > > PF fortran/89647 > resolve.c (resolve_typebound_procedure): Allow host associated > procedure to be a binding target. While here, wrap long line. > > 2019-08-12 Steven G. Kargl <kargl@gcc.gnu.org> > > PF fortran/89647 > * gfortran.dg/pr89647.f90: New test. > > OK to commit? Ok, thanks.
On Tue, Aug 13, 2019 at 09:52:01AM +0300, Janne Blomqvist wrote: > On Tue, Aug 13, 2019 at 1:32 AM Steve Kargl > <sgk@troutmask.apl.washington.edu> wrote: > > > > The attached patch fixes PR fortran/89647, and has been > > regression tested on x86_64-*-freebsd. > > > > If a procedure is made accessible by host association, the > > that procedure can be used as binding target. During the > > resolution of a type bound procedure, gfortran needs to > > check the parent namespace for a procedure before it fails. > > > > 2019-08-12 Steven G. Kargl <kargl@gcc.gnu.org> > > > > PF fortran/89647 > > resolve.c (resolve_typebound_procedure): Allow host associated > > procedure to be a binding target. While here, wrap long line. > > > > 2019-08-12 Steven G. Kargl <kargl@gcc.gnu.org> > > > > PF fortran/89647 > > * gfortran.dg/pr89647.f90: New test. > > > > OK to commit? > > Ok, thanks. Committed to trunk. Committed to 9-branch after successful regression testing.
Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 274320) +++ gcc/fortran/resolve.c (working copy) @@ -13583,14 +13583,34 @@ resolve_typebound_procedure (gfc_symtree* stree) } else { + /* If proc has not been resolved at this point, proc->name may + actually be a USE associated entity. See PR fortran/89647. */ + if (!proc->resolved + && proc->attr.function == 0 && proc->attr.subroutine == 0) + { + gfc_symbol *tmp; + gfc_find_symbol (proc->name, gfc_current_ns->parent, 1, &tmp); + if (tmp && tmp->attr.use_assoc) + { + proc->module = tmp->module; + proc->attr.proc = tmp->attr.proc; + proc->attr.function = tmp->attr.function; + proc->attr.subroutine = tmp->attr.subroutine; + proc->attr.use_assoc = tmp->attr.use_assoc; + proc->ts = tmp->ts; + proc->result = tmp->result; + } + } + /* Check for F08:C465. */ if ((!proc->attr.subroutine && !proc->attr.function) || (proc->attr.proc != PROC_MODULE && proc->attr.if_source != IFSRC_IFBODY) || proc->attr.abstract) { - gfc_error ("%qs must be a module procedure or an external procedure with" - " an explicit interface at %L", proc->name, &where); + gfc_error ("%qs must be a module procedure or an external " + "procedure with an explicit interface at %L", + proc->name, &where); goto error; } } Index: gcc/testsuite/gfortran.dg/pr89647.f90 =================================================================== --- gcc/testsuite/gfortran.dg/pr89647.f90 (nonexistent) +++ gcc/testsuite/gfortran.dg/pr89647.f90 (working copy) @@ -0,0 +1,33 @@ +! { dg-do compile } +! Code contributed by Ian Harvey <ian_harvey at bigpond dot com> + MODULE m1 + IMPLICIT NONE + PUBLIC :: False + PUBLIC :: True + CONTAINS + FUNCTION False() RESULT(b) + LOGICAL :: b + b = .FALSE. + END FUNCTION False + + FUNCTION True() RESULT(b) + LOGICAL :: b + b = .TRUE. + END FUNCTION True + END MODULE m1 + + MODULE m2 + USE m1 + IMPLICIT NONE + TYPE, ABSTRACT :: t_parent + CONTAINS + PROCEDURE(False), DEFERRED, NOPASS :: Binding + END TYPE t_parent + CONTAINS + SUBROUTINE s + TYPE, EXTENDS(t_parent) :: t_extension + CONTAINS + PROCEDURE, NOPASS :: Binding => True + END TYPE t_extension + END SUBROUTINE s + END MODULE m2