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

Attachment: 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

Reply via email to