Commit ae86ede8 by Tobias Burnus

[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.
parent f626ae54
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> 2020-02-01 Jakub Jelinek <jakub@redhat.com>
PR fortran/92305 PR fortran/92305
......
...@@ -8846,8 +8846,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) ...@@ -8846,8 +8846,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
if (tsym->attr.subroutine if (tsym->attr.subroutine
|| tsym->attr.external || tsym->attr.external
|| (tsym->attr.function || (tsym->attr.function && tsym->result != tsym))
&& (tsym->result != tsym || tsym->attr.recursive)))
{ {
gfc_error ("Associating entity %qs at %L is a procedure name", gfc_error ("Associating entity %qs at %L is a procedure name",
tsym->name, &target->where); tsym->name, &target->where);
......
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> 2020-02-03 Jakub Jelinek <jakub@redhat.com>
PR target/93533 PR target/93533
......
...@@ -14,7 +14,14 @@ end ...@@ -14,7 +14,14 @@ end
recursive function f2() recursive function f2()
associate (y1 => f2()) ! { dg-error "Invalid association target" } associate (y1 => f2()) ! { dg-error "Invalid association target" }
end associate ! { dg-error "Expecting END FUNCTION statement" } 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 associate
end end
......
! { 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment