The attached patch builds on a draft posted by Steve Kargl. I have left the gcc_assert in place just in case my imagination was too limited to generate an ICE.
Regtests OK on FC31/x86_64 - OK for trunk? Paul
Change.Logs
Description: Binary data
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 2751c0ccf62..4046bed1863 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -5993,6 +5993,17 @@ check_host_association (gfc_expr *e) if (ref->type == REF_ARRAY && ref->next == NULL) break; + if ((ref == NULL || ref->type != REF_ARRAY) + && old_sym->attr.flavor == FL_VARIABLE + && sym->attr.proc == PROC_INTERNAL) + { + gfc_error ("%qs at %L is being host associated into " + "a contained procedure with an internal " + "procedure of the same name", sym->name, + &sym->declared_at); + return false; + } + gcc_assert (ref->type == REF_ARRAY); /* Grab the start expressions from the array ref and
! { dg-do compile } ! ! Test the fix for PR96102 in which the two lines with IF statements ! errors previously caused a segfault. ! ! Contributed by Gerhardt Steinmetz <gs...@t-online.de> ! ! 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