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 <[email protected]>
!
!
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
