OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/89647 (Host associated procedure unable to be used as binding target) 

2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89647
	resolve.c (resolve_typebound_procedure): Allow host associated 
	procedure to be a binding target.  While here, wrap long line.

2019-08-13  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/89647
	* gfortran.dg/pr89647.f90: New test.

From-SVN: r274393
This commit is contained in:
Steven G. Kargl 2019-08-13 18:35:33 +00:00
parent 5fbc8ab48a
commit eabd9d9167
4 changed files with 66 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2019-08-13 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/89647
resolve.c (resolve_typebound_procedure): Allow host associated
procedure to be a binding target. While here, wrap long line.
2019-08-13 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/87993

24
gcc/fortran/resolve.c
View File

@ -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;
}
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-08-13 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/89647
* gfortran.dg/pr89647.f90: New test.
2019-08-13 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/87993

33
gcc/testsuite/gfortran.dg/pr89647.f90 Normal file
View File

@ -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