This patch fixes PR96102. See the explanatory comment in the testcase.

2020-08-10  Paul Thomas  <pault@gcc.gnu.org>

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.

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 2751c0ccf62f1a799648a509300cb954b689a2f5..6caddcf4ef02c5e826f7ede4984921d848173dd1 100644 (file)
--- 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 (file)
index 0000000..0cf5222
--- /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  <gscfq@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