[Fortran] Fix to strict associate check (PR93427)

PR fortran/93427
        * resolve.c (resolve_assoc_var): Remove too strict check.
        * gfortran.dg/associate_51.f90: Update test case.

        PR fortran/93427
        * gfortran.dg/associate_52.f90: New.
This commit is contained in:
Tobias Burnus 2020-02-03 10:00:07 +01:00
parent f626ae5478
commit ae86ede8e9
5 changed files with 44 additions and 3 deletions

View File

@ -1,3 +1,9 @@
2020-02-03 Tobias Burnus <tobias@codesourcery.com>
PR fortran/93427
* resolve.c (resolve_assoc_var): Remove too strict check.
* gfortran.dg/associate_51.f90: Update test case.
2020-02-01 Jakub Jelinek <jakub@redhat.com>
PR fortran/92305

View File

@ -8846,8 +8846,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
if (tsym->attr.subroutine
|| tsym->attr.external
|| (tsym->attr.function
&& (tsym->result != tsym || tsym->attr.recursive)))
|| (tsym->attr.function && tsym->result != tsym))
{
gfc_error ("Associating entity %qs at %L is a procedure name",
tsym->name, &target->where);

View File

@ -1,3 +1,8 @@
2020-02-03 Tobias Burnus <tobias@codesourcery.com>
PR fortran/93427
* gfortran.dg/associate_52.f90: New.
2020-02-03 Jakub Jelinek <jakub@redhat.com>
PR target/93533

View File

@ -14,7 +14,14 @@ end
recursive function f2()
associate (y1 => f2()) ! { dg-error "Invalid association target" }
end associate ! { dg-error "Expecting END FUNCTION statement" }
associate (y2 => f2) ! { dg-error "is a procedure name" }
end
recursive function f3()
associate (y1 => f3)
print *, y1() ! { dg-error "Expected array subscript" }
end associate
associate (y2 => f3) ! { dg-error "Associate-name 'y2' at \\(1\\) is used as array" }
print *, y2(1)
end associate
end

View File

@ -0,0 +1,24 @@
! { dg-do compile }
!
! PR fortran/93427
!
! Contributed by Andrew Benson
!
module a
type :: t
end type t
contains
recursive function b()
class(t), pointer :: b
type(t) :: c
allocate(t :: b)
select type (b)
type is (t)
b=c
end select
end function b
end module a