From 359815ad136ee6ad142fb54470ce79609e43ff5d Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 10 Aug 2020 06:19:25 +0100 Subject: [PATCH] This patch fixes PR96102. See the explanatory comment in the testcase. 2020-08-10 Paul Thomas gcc/fortran PR fortran/96102 * resolve.c (check_host_association): Replace the gcc_assert with an error for internal procedures. gcc/testsuite/ PR fortran/96102 * gfortran.dg/pr96102.f90: New test. --- gcc/fortran/resolve.c | 10 ++++++++++ gcc/testsuite/gfortran.dg/pr96102.f90 | 27 +++++++++++++++++++++++++++ 2 files changed, 37 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/pr96102.f90 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2751c0ccf62..6caddcf4ef0 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5993,6 +5993,16 @@ check_host_association (gfc_expr *e) if (ref->type == REF_ARRAY && ref->next == NULL) break; + if ((ref == NULL || ref->type != REF_ARRAY) + && sym->attr.proc == PROC_INTERNAL) + { + gfc_error ("%qs at %L is host associated at %L into " + "a contained procedure with an internal " + "procedure of the same name", sym->name, + &old_sym->declared_at, &e->where); + return false; + } + gcc_assert (ref->type == REF_ARRAY); /* Grab the start expressions from the array ref and diff --git a/gcc/testsuite/gfortran.dg/pr96102.f90 b/gcc/testsuite/gfortran.dg/pr96102.f90 new file mode 100644 index 00000000000..0cf52226d85 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96102.f90 @@ -0,0 +1,27 @@ +! { dg-do compile } +! +! Test the fix for PR96102 in which the two lines with errors previously +! caused a segfault. +! +! Contributed by Gerhardt Steinmetz +! +! +module m + type mytype + integer :: i + end type + type(mytype) :: d = mytype (42) ! { dg-error "is host associated" } + integer :: n = 2 ! { dg-error "is host associated" } +contains + subroutine s + if ( n /= 0 ) stop 1 ! { dg-error "internal procedure of the same name" } + if ( d%i /= 0 ) stop 2 ! { dg-error "internal procedure of the same name" } + contains + integer function n() + n = 0 + end + type(mytype) function d() + d = mytype (0) + end + end +end -- 2.30.2