From ae86ede8e988d1863b92a19f35d5f7c6b998bf8c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Mon, 3 Feb 2020 10:00:07 +0100 Subject: [PATCH] [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. --- gcc/fortran/ChangeLog | 6 ++++++ gcc/fortran/resolve.c | 3 +-- gcc/testsuite/ChangeLog | 5 +++++ gcc/testsuite/gfortran.dg/associate_51.f90 | 9 ++++++++- gcc/testsuite/gfortran.dg/associate_52.f90 | 24 ++++++++++++++++++++++++ 5 files changed, 44 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/associate_52.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2b188e5..570cacb 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2020-02-03 Tobias Burnus + + 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 PR fortran/92305 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index e840aec..8f5267f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 86b9edc..8f11697 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2020-02-03 Tobias Burnus + + PR fortran/93427 + * gfortran.dg/associate_52.f90: New. + 2020-02-03 Jakub Jelinek PR target/93533 diff --git a/gcc/testsuite/gfortran.dg/associate_51.f90 b/gcc/testsuite/gfortran.dg/associate_51.f90 index 7b3edc4..b6ab141 100644 --- a/gcc/testsuite/gfortran.dg/associate_51.f90 +++ b/gcc/testsuite/gfortran.dg/associate_51.f90 @@ -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 diff --git a/gcc/testsuite/gfortran.dg/associate_52.f90 b/gcc/testsuite/gfortran.dg/associate_52.f90 new file mode 100644 index 0000000..c24ec4b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/associate_52.f90 @@ -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 -- 2.7.4