re PR fortran/64508 ([F03] interface check missing for procedure pointer component as actual argument)
2015-01-11 Janus Weil <janus@gcc.gnu.org> PR fortran/64508 * interface.c (compare_parameter): Interface check for procedure-pointer component as actual argument. 2015-01-11 Janus Weil <janus@gcc.gnu.org> PR fortran/64508 * gfortran.dg/proc_ptr_comp_41.f90: New. From-SVN: r219431
This commit is contained in:
parent
830aecf07f
commit
5c0ba546b8
|
@ -1,3 +1,9 @@
|
|||
2015-01-11 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
PR fortran/64508
|
||||
* interface.c (compare_parameter): Interface check for
|
||||
procedure-pointer component as actual argument.
|
||||
|
||||
2015-01-10 Thomas Schwinge <thomas@codesourcery.com>
|
||||
|
||||
* gfortran.texi: Update for libgomp being renamed from "GNU OpenMP
|
||||
|
|
|
@ -1922,6 +1922,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
|||
{
|
||||
gfc_ref *ref;
|
||||
bool rank_check, is_pointer;
|
||||
char err[200];
|
||||
gfc_component *ppc;
|
||||
|
||||
/* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
|
||||
procs c_f_pointer or c_f_procpointer, and we need to accept most
|
||||
|
@ -1942,7 +1944,6 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
|||
|
||||
if (actual->ts.type == BT_PROCEDURE)
|
||||
{
|
||||
char err[200];
|
||||
gfc_symbol *act_sym = actual->symtree->n.sym;
|
||||
|
||||
if (formal->attr.flavor != FL_PROCEDURE)
|
||||
|
@ -1976,6 +1977,19 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
|
|||
return 1;
|
||||
}
|
||||
|
||||
ppc = gfc_get_proc_ptr_comp (actual);
|
||||
if (ppc)
|
||||
{
|
||||
if (!gfc_compare_interfaces (formal, ppc->ts.interface, ppc->name, 0, 1,
|
||||
err, sizeof(err), NULL, NULL))
|
||||
{
|
||||
if (where)
|
||||
gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s",
|
||||
formal->name, &actual->where, err);
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
/* F2008, C1241. */
|
||||
if (formal->attr.pointer && formal->attr.contiguous
|
||||
&& !gfc_is_simply_contiguous (actual, true))
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2015-01-11 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
PR fortran/64508
|
||||
* gfortran.dg/proc_ptr_comp_41.f90: New.
|
||||
|
||||
2015-01-11 Segher Boessenkool <segher@kernel.crashing.org>
|
||||
|
||||
* gcc.target/powerpc/recip-test.h (_ARCH_PPC64): Use __LP64__ instead.
|
||||
|
|
|
@ -0,0 +1,34 @@
|
|||
! { dg-do compile }
|
||||
!
|
||||
! PR 64508: [F03] interface check missing for procedure pointer component as actual argument
|
||||
!
|
||||
! Contributed by Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
TYPE :: parent
|
||||
END TYPE
|
||||
|
||||
TYPE, EXTENDS(parent) :: extension
|
||||
procedure(extension_proc), pointer :: ppc
|
||||
END TYPE
|
||||
|
||||
CLASS(extension), ALLOCATABLE :: x
|
||||
CALL some_proc(x%ppc) ! { dg-error "Interface mismatch in dummy procedure" }
|
||||
|
||||
contains
|
||||
|
||||
SUBROUTINE parent_proc(arg)
|
||||
CLASS(parent), INTENT(IN) :: arg
|
||||
END SUBROUTINE
|
||||
|
||||
SUBROUTINE extension_proc(arg)
|
||||
CLASS(extension), INTENT(IN) :: arg
|
||||
END SUBROUTINE
|
||||
|
||||
|
||||
SUBROUTINE some_proc(proc)
|
||||
PROCEDURE(parent_proc) :: proc
|
||||
TYPE(Parent) :: a
|
||||
CALL proc(a)
|
||||
END SUBROUTINE
|
||||
|
||||
end
|
Loading…
Reference in New Issue