[PATCH] PR fortran/78741 -- Detect clash of entry and subroutine name

[Steve Kargl <sgk at troutmask dot apl dot washington dot edu>]

The patch is fairly slef-explanatory.
Regression tested on x86_64-*-freebsd.
OK to commit?

2018-03-15  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78741
	* decl.c (get_proc_name):  Check for clash of entry name with
	subroutine name.

2018-03-15  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/78741
	* gfortran.dg/pr78741.f90: New test.

-- 
Steve

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 258571)
+++ gcc/fortran/decl.c	(working copy)
@@ -804,7 +804,7 @@ cleanup:
 static bool
 merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
 {
-  int i;
+  int i, j;
 
   if ((from->type == AS_ASSUMED_RANK && to->corank)
       || (to->type == AS_ASSUMED_RANK && from->corank))
@@ -822,8 +822,14 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec
 
       for (i = 0; i < to->corank; i++)
 	{
-	  to->lower[from->rank + i] = to->lower[i];
-	  to->upper[from->rank + i] = to->upper[i];
+	  /* Do not exceed the limits on lower[] and upper[].  gfortran
+	     cleans up elsewhere.  */
+	  j = from->rank + i;
+	  if (j >= GFC_MAX_DIMENSIONS)
+	    break;
+
+	  to->lower[j] = to->lower[i];
+	  to->upper[j] = to->upper[i];
 	}
       for (i = 0; i < from->rank; i++)
 	{
@@ -846,19 +852,33 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec
 
       for (i = 0; i < from->corank; i++)
 	{
+	  /* Do not exceed the limits on lower[] and upper[].  gfortran
+	     cleans up elsewhere.  */
+	  j = to->rank + i;
+	  if (j >= GFC_MAX_DIMENSIONS)
+	    break;
+
 	  if (copy)
 	    {
-	      to->lower[to->rank + i] = gfc_copy_expr (from->lower[i]);
-	      to->upper[to->rank + i] = gfc_copy_expr (from->upper[i]);
+	      to->lower[j] = gfc_copy_expr (from->lower[i]);
+	      to->upper[j] = gfc_copy_expr (from->upper[i]);
 	    }
 	  else
 	    {
-	      to->lower[to->rank + i] = from->lower[i];
-	      to->upper[to->rank + i] = from->upper[i];
+	      to->lower[j] = from->lower[i];
+	      to->upper[j] = from->upper[i];
 	    }
 	}
     }
 
+  if (to->rank + to->corank >= GFC_MAX_DIMENSIONS)
+    {
+      gfc_error ("Sum of array rank %d and corank %d at %C exceeds maximum "
+		 "allowed dimensions of %d",
+		 to->rank, to->corank, GFC_MAX_DIMENSIONS);
+      to->corank = GFC_MAX_DIMENSIONS - to->rank;
+      return false;
+    }
   return true;
 }
 
@@ -1189,8 +1209,13 @@ get_proc_name (const char *name, gfc_symbol **result, 
 	 accessible names.  */
       if (sym->attr.flavor != 0
 	  && sym->attr.proc != 0
-	  && (sym->attr.subroutine || sym->attr.function)
+	  && (sym->attr.subroutine || sym->attr.function || sym->attr.entry)
 	  && sym->attr.if_source != IFSRC_UNKNOWN)
+	gfc_error_now ("Procedure %qs at %C is already defined at %L",
+		       name, &sym->declared_at);
+
+      if (sym->attr.flavor != 0
+	  && sym->attr.entry && sym->attr.if_source != IFSRC_UNKNOWN)
 	gfc_error_now ("Procedure %qs at %C is already defined at %L",
 		       name, &sym->declared_at);
 
Index: gcc/testsuite/gfortran.dg/pr78741.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr78741.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr78741.f90	(working copy)
@@ -0,0 +1,16 @@
+! { dg-do compile }
+! PR fortran/78741
+! Contributed by Gerhard Steinmetz <gerhard.steinmetz.fortran at t-online.de>
+subroutine s(n, x)
+   integer :: n
+   character(n) :: x
+   character, pointer :: z(:)
+   x = 'a'
+   return
+entry g(n, x)           ! { dg-error "is already defined" }
+   x = 'b'
+contains
+   subroutine g         ! { dg-error "(1)" }
+      z(1) = x(1:1)
+   end
+end