diff mbox

[Fortran,F03] PR 58023: ICE on invalid with bad PPC declaration

Message ID CAKwh3qgxX6ehpo5xG_qc72WsEMMshcZ9t-tYW-vBufcxpo6ajg@mail.gmail.com
State New
Headers show

Commit Message

Janus Weil Jan. 14, 2015, 6:30 p.m. UTC
Hi Mikael,

>> the attached patch fixes an ICE-on-invalid problem with
>> procedure-pointer components by making sure that we continue resolving
>> all components of a derived type, even after an error is thrown.
>>
> Does the fonction return false as before, whenever an error has been
> issued?  I have the feeling it doesn't any more with the patch.

yeah, you're right. The attached new version fixes that. Better?

Cheers,
Janus

Comments

Mikael Morin Jan. 15, 2015, 1:22 p.m. UTC | #1
Le 14/01/2015 19:30, Janus Weil a écrit :
> Hi Mikael,
> 
>>> the attached patch fixes an ICE-on-invalid problem with
>>> procedure-pointer components by making sure that we continue resolving
>>> all components of a derived type, even after an error is thrown.
>>>
>> Does the fonction return false as before, whenever an error has been
>> issued?  I have the feeling it doesn't any more with the patch.
> 
> yeah, you're right. The attached new version fixes that. Better?
> 
Yes, OK. Thanks.

Mikael
Janus Weil Jan. 15, 2015, 6:31 p.m. UTC | #2
2015-01-15 14:22 GMT+01:00 Mikael Morin <mikael.morin@sfr.fr>:
>>>> the attached patch fixes an ICE-on-invalid problem with
>>>> procedure-pointer components by making sure that we continue resolving
>>>> all components of a derived type, even after an error is thrown.
>>>>
>>> Does the fonction return false as before, whenever an error has been
>>> issued?  I have the feeling it doesn't any more with the patch.
>>
>> yeah, you're right. The attached new version fixes that. Better?
>>
> Yes, OK. Thanks.

Committed as r219676. Thanks for reviewing!

Cheers,
Janus
diff mbox

Patch

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 219607)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -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)