This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[PATCH] PR fortran/89647 -- Allow host associated procedure to be a binding target
- From: Steve Kargl <sgk at troutmask dot apl dot washington dot edu>
- To: fortran at gcc dot gnu dot org, gcc-patches at gcc dot gnu dot org
- Date: Mon, 12 Aug 2019 15:32:24 -0700
- Subject: [PATCH] PR fortran/89647 -- Allow host associated procedure to be a binding target
- Reply-to: sgk at troutmask dot apl dot washington dot edu
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?
--
Steve
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