Hi all, the attached patch fixes some checking code for PASS arguments in procedure-pointer components, which does not properly account for the fact that the PASS argument needs to be polymorphic.
[The reason for this issue is probably that PPCs were mostly implemented before polymorphism was available. The corresponding pass-arg checks for TBPs are ok.] The patch also fixes an invalid test case (which was detected thanks to Neil Carlson). It regtests cleanly on x86_64-linux-gnu. Ok for trunk? Cheers, Janus 2018-02-09 Janus Weil <ja...@gcc.gnu.org> PR fortran/84273 * resolve.c (resolve_component): Fix checks of passed argument in procedure-pointer components. 2018-02-09 Janus Weil <ja...@gcc.gnu.org> PR fortran/84273 * gfortran.dg/proc_ptr_47.f90: Fix invalid test case. * gfortran.dg/proc_ptr_comp_pass_4.f90: Fix and extend test case.
Index: gcc/fortran/resolve.c =================================================================== --- gcc/fortran/resolve.c (revision 257498) +++ gcc/fortran/resolve.c (working copy) @@ -13703,8 +13703,8 @@ resolve_component (gfc_component *c, gfc_symbol *s return false; } - /* Check for C453. */ - if (me_arg->attr.dimension) + /* Check for F03:C453. */ + if (CLASS_DATA (me_arg)->attr.dimension) { gfc_error ("Argument %qs of %qs with PASS(%s) at %L " "must be scalar", me_arg->name, c->name, me_arg->name, @@ -13713,7 +13713,7 @@ resolve_component (gfc_component *c, gfc_symbol *s return false; } - if (me_arg->attr.pointer) + if (CLASS_DATA (me_arg)->attr.class_pointer) { gfc_error ("Argument %qs of %qs with PASS(%s) at %L " "may not have the POINTER attribute", me_arg->name, @@ -13722,7 +13722,7 @@ resolve_component (gfc_component *c, gfc_symbol *s return false; } - if (me_arg->attr.allocatable) + if (CLASS_DATA (me_arg)->attr.allocatable) { gfc_error ("Argument %qs of %qs with PASS(%s) at %L " "may not be ALLOCATABLE", me_arg->name, c->name, Index: gcc/testsuite/gfortran.dg/proc_ptr_47.f90 =================================================================== --- gcc/testsuite/gfortran.dg/proc_ptr_47.f90 (revision 257498) +++ gcc/testsuite/gfortran.dg/proc_ptr_47.f90 (working copy) @@ -21,13 +21,9 @@ contains function foo(A) - class(AA), allocatable :: A + class(AA) :: A type(AA) foo - if (.not.allocated (A)) then - allocate (A, source = AA (2, foo)) - endif - select type (A) type is (AA) foo = AA (3, foo) Index: gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 =================================================================== --- gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 (revision 257498) +++ gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 (working copy) @@ -37,22 +37,23 @@ module m type :: t8 procedure(foo8), pass, pointer :: f8 ! { dg-error "must be of the derived type" } + procedure(foo9), pass, pointer :: f9 ! { dg-error "Non-polymorphic passed-object dummy argument" } end type contains subroutine foo1 (x1,y1) - type(t1) :: x1(:) + class(t1) :: x1(:) type(t1) :: y1 end subroutine subroutine foo2 (x2,y2) - type(t2),pointer :: x2 + class(t2),pointer :: x2 type(t2) :: y2 end subroutine subroutine foo3 (x3,y3) - type(t3),allocatable :: x3 + class(t3),allocatable :: x3 type(t3) :: y3 end subroutine @@ -69,4 +70,8 @@ contains integer :: i end function + subroutine foo9(x) + type(t8) :: x + end subroutine + end module m