diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/resolve.c | 8 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_47.f90 | 6 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 | 11 |
5 files changed, 25 insertions, 12 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 43500f1..6f416b3 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -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 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 429c1c4..01e2c38 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bf84125..c4ae3e3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -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 diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_47.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_47.f90 index 43084f6..80a78f3 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_47.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_47.f90 @@ -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) diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 index b0e7a77..1632e27 100644 --- a/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 +++ b/gcc/testsuite/gfortran.dg/proc_ptr_comp_pass_4.f90 @@ -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 |