procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/84273 ([F03] Reject allocatable passed-object dummy argument (proc_ptr_47.f90))

Browse source 
2018-02-12  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/84273
	* resolve.c (resolve_component): Fix checks of passed argument in
	procedure-pointer components.


2018-02-12  Janus Weil  <janus@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.

From-SVN: r257590
This commit is contained in:
Janus Weil 2018-02-12 18:11:58 +01:00
parent 78604de064
commit 24abcc441a
5 changed files with 25 additions and 12 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 @@
2018-02-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/84273
* resolve.c (resolve_component): Fix checks of passed argument in
procedure-pointer components.
2018-02-11 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/35299

8
gcc/fortran/resolve.c
View file

@ -13706,8 +13706,8 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
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,
@ -13716,7 +13716,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
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,
@ -13725,7 +13725,7 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
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,

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2018-02-12 Janus Weil <janus@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.
2018-02-12 Tamar Christina <tamar.christina@arm.com>
PR target/82641

6
gcc/testsuite/gfortran.dg/proc_ptr_47.f90
View file

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

11
gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90
View file

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