re PR fortran/58023 ([F03] ICE on invalid with bad PPC declaration)

2015-01-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58023
	* resolve.c (resolve_fl_derived0): Continue resolving next component
	after error.

2015-01-15  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/58023
	* gfortran.dg/proc_ptr_comp_43.f90: New.

From-SVN: r219676

gcc/fortran/ChangeLog

+2015-01-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/58023
+	* resolve.c (resolve_fl_derived0): Continue resolving next component
+	after error.
+
 2015-01-14  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
 	PR fortran/61933

gcc/fortran/resolve.c

@@ -12377,6 +12377,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
   c = (sym->attr.is_class) ? sym->components->ts.u.derived->components
 			   : sym->components;
 
+  bool success = true;
+
   for ( ; c != NULL; c = c->next)
     {
       if (c->attr.artificial)
@@ -12389,7 +12391,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	{
 	  gfc_error ("Coarray component %qs at %L must be allocatable with "
 		     "deferred shape", c->name, &c->loc);
-	  return false;
+	  success = false;
+	  continue;
 	}
 
       /* F2008, C443.  */
@@ -12398,7 +12401,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	{
 	  gfc_error ("Component %qs at %L of TYPE(C_PTR) or TYPE(C_FUNPTR) "
 		     "shall not be a coarray", c->name, &c->loc);
-	  return false;
+	  success = false;
+	  continue;
 	}
 
       /* F2008, C444.  */
@@ -12409,7 +12413,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  gfc_error ("Component %qs at %L with coarray component "
 		     "shall be a nonpointer, nonallocatable scalar",
 		     c->name, &c->loc);
-	  return false;
+	  success = false;
+	  continue;
 	}
 
       /* F2008, C448.  */
@@ -12417,7 +12422,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	{
 	  gfc_error ("Component %qs at %L has the CONTIGUOUS attribute but "
 		     "is not an array pointer", c->name, &c->loc);
-	  return false;
+	  success = false;
+	  continue;
 	}
 
       if (c->attr.proc_pointer && c->ts.interface)
@@ -12427,7 +12433,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	  if (!sym->attr.vtype && !check_proc_interface (ifc, &c->loc))
 	    {
 	      c->tb->error = 1;
-	      return false;
+	      success = false;
+	      continue;
 	    }
 
 	  if (ifc->attr.if_source || ifc->attr.intrinsic)
@@ -12471,7 +12478,11 @@ resolve_fl_derived0 (gfc_symbol *sym)
 		  gfc_charlen *cl = gfc_new_charlen (sym->ns, ifc->ts.u.cl);
 		  if (cl->length && !cl->resolved
 		      && !gfc_resolve_expr (cl->length))
-		    return false;
+		    {
+		      c->tb->error = 1;
+		      success = false;
+		      continue;
+		    }
 		  c->ts.u.cl = cl;
 		}
 	    }
@@ -12514,7 +12525,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 			     "at %L has no argument %qs", c->name,
 			     c->tb->pass_arg, &c->loc, c->tb->pass_arg);
 		  c->tb->error = 1;
-		  return false;
+		  success = false;
+		  continue;
 		}
 	    }
 	  else
@@ -12528,7 +12540,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 			     "must have at least one argument",
 			     c->name, &c->loc);
 		  c->tb->error = 1;
-		  return false;
+		  success = false;
+		  continue;
 		}
 	      me_arg = c->ts.interface->formal->sym;
 	    }
@@ -12544,7 +12557,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 			 " the derived type %qs", me_arg->name, c->name,
 			 me_arg->name, &c->loc, sym->name);
 	      c->tb->error = 1;
-	      return false;
+	      success = false;
+	      continue;
 	    }
 
 	  /* Check for C453.  */
@@ -12554,7 +12568,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 			 "must be scalar", me_arg->name, c->name, me_arg->name,
 			 &c->loc);
 	      c->tb->error = 1;
-	      return false;
+	      success = false;
+	      continue;
 	    }
 
 	  if (me_arg->attr.pointer)
@@ -12563,7 +12578,8 @@ resolve_fl_derived0 (gfc_symbol *sym)
 			 "may not have the POINTER attribute", me_arg->name,
 			 c->name, me_arg->name, &c->loc);
 	      c->tb->error = 1;
-	      return false;
+	      success = false;
+	      continue;
 	    }
 
 	  if (me_arg->attr.allocatable)
@@ -12572,12 +12588,17 @@ resolve_fl_derived0 (gfc_symbol *sym)
 			 "may not be ALLOCATABLE", me_arg->name, c->name,
 			 me_arg->name, &c->loc);
 	      c->tb->error = 1;
-	      return false;
+	      success = false;
+	      continue;
 	    }
 
 	  if (gfc_type_is_extensible (sym) && me_arg->ts.type != BT_CLASS)
-	    gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
-		       " at %L", c->name, &c->loc);
+	    {
+	      gfc_error ("Non-polymorphic passed-object dummy argument of %qs"
+			 " at %L", c->name, &c->loc);
+	      success = false;
+	      continue;
+	    }
 
 	}
 
@@ -12746,6 +12767,9 @@ resolve_fl_derived0 (gfc_symbol *sym)
 	return false;
     }
 
+  if (!success)
+    return false;
+
   check_defined_assignments (sym);
 
   if (!sym->attr.defined_assign_comp && super_type)

gcc/testsuite/ChangeLog

+2015-01-15  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/58023
+	* gfortran.dg/proc_ptr_comp_43.f90: New.
+
 2015-01-15  Mike Stump  <mikestump@comcast.net>
 
 	* gcc.dg/unroll_1.c: Rename gcc.dg/unroll_[1-5].c to unroll-[2-6].

gcc/testsuite/gfortran.dg/proc_ptr_comp_43.f90

+! { dg-do compile }
+!
+! PR 58023: [F03] ICE on invalid with bad PPC declaration
+!
+! Contributed by Andrew Benson <abensonca@gmail.com>
+
+module m
+  implicit none
+
+  abstract interface
+     double precision function mr()
+     end function mr
+  end interface
+
+  type :: sfd
+     procedure(mr), pointer :: mr1  ! { dg-error "must have at least one argument" }
+     procedure(mr), pointer :: mr2  ! { dg-error "must have at least one argument" }
+  end type sfd
+
+contains
+
+  subroutine go()
+    implicit none
+    type(sfd):: d
+
+    write (0,*) d%mr2()
+    return
+  end subroutine go
+
+end module m
+
+! { dg-final { cleanup-modules "m" } }