diff mbox

[Fortran,OOP] PR 48095: Invalid assignment to procedure pointer component not rejected

Message ID CAKwh3qiNn1r0oLJz-ubOApyc3F-evgyOWy6bDG=p6ObVVpdNag@mail.gmail.com
State New
Headers show

Commit Message

Janus Weil Sept. 7, 2011, 9:14 p.m. UTC 
Hi Tobias,

>> +         if (s2&&  !gfc_compare_interfaces (comp->ts.interface, s2, name,
>> 0, 1,
>> +                                            err, sizeof(err)))
>
> Space after sizeof.

Fixed.


>> +             gfc_error ("In derived type constructor at %L: Interface
>> mismatch"
>> +                        " in procedure pointer component '%s': %s",
>> +                       &cons->expr->where, comp->name, err);
>
> Somehow, I find the words clumsy with too many colons. "derived type
> constructor" - I'd use a hyphen ("derived-type") and I want to note that the
> standard calls it "structure constructor"; I also would use "for ...
> component" and not "in ... component" and add a hyphen to "procedure
> pointer".

You are right about the hyphens, and I also agree that it makes more
sense to stick to the standard language. Note: My wording was partly
copied over from other error messages in resolve_structure_cons, all
of which use "derived type constructor". I'm changing all of them in
the attached update of the patch.


> How about a simpler: "Interface mismatch for procedure-pointer component
> '%s' at %L: %s"? I think it should be clear from the context that it is
> about a structure constructor. Or for the long version, how about:
> "Interface mismatch for procedure-pointer component '%s' in structure
> constructor at %L: %s"?

I prefer the second variant.

I'll do another regtest with the updated patch (the changed error
messages might need testsuite adaptions?) and then go ahead and commit
it.

Thanks for the review.

Cheers,
Janus

Comments

Janus Weil Sept. 7, 2011, 10:23 p.m. UTC | #1 
> I'll do another regtest with the updated patch (the changed error
> messages might need testsuite adaptions?) and then go ahead and commit
> it.

Committed as r178665 with some minor corrections.

Cheers,
Janus
diff mbox

Patch

Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 178659)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1013,7 +1013,7 @@  resolve_structure_cons (gfc_expr *expr, int init)
       if (cons->expr->expr_type != EXPR_NULL && rank != cons->expr->rank
 	  && (comp->attr.allocatable || cons->expr->rank))
 	{
-	  gfc_error ("The rank of the element in the derived type "
+	  gfc_error ("The rank of the element in the structure "
 		     "constructor at %L does not match that of the "
 		     "component (%d/%d)", &cons->expr->where,
 		     cons->expr->rank, rank);
@@ -1035,7 +1035,7 @@  resolve_structure_cons (gfc_expr *expr, int init)
 	      t = SUCCESS;
 	    }
 	  else if (comp->attr.pointer && cons->expr->ts.type != BT_UNKNOWN)
-	    gfc_error ("The element in the derived type constructor at %L, "
+	    gfc_error ("The element in the structure constructor at %L, "
 		       "for pointer component '%s', is %s but should be %s",
 		       &cons->expr->where, comp->name,
 		       gfc_basic_typename (cons->expr->ts.type),
@@ -1113,12 +1113,46 @@  resolve_structure_cons (gfc_expr *expr, int init)
 		       || CLASS_DATA (comp)->attr.allocatable))))
 	{
 	  t = FAILURE;
-	  gfc_error ("The NULL in the derived type constructor at %L is "
+	  gfc_error ("The NULL in the structure constructor at %L is "
 		     "being applied to component '%s', which is neither "
 		     "a POINTER nor ALLOCATABLE", &cons->expr->where,
 		     comp->name);
 	}
 
+      if (comp->attr.proc_pointer && comp->ts.interface)
+	{
+	  /* Check procedure pointer interface.  */
+	  gfc_symbol *s2 = NULL;
+	  gfc_component *c2;
+	  const char *name;
+	  char err[200];
+
+	  if (gfc_is_proc_ptr_comp (cons->expr, &c2))
+	    {
+	      s2 = c2->ts.interface;
+	      name = c2->name;
+	    }
+	  else if (cons->expr->expr_type == EXPR_FUNCTION)
+	    {
+	      s2 = cons->expr->symtree->n.sym->result;
+	      name = cons->expr->symtree->n.sym->result->name;
+	    }
+	  else if (cons->expr->expr_type != EXPR_NULL)
+	    {
+	      s2 = cons->expr->symtree->n.sym;
+	      name = cons->expr->symtree->n.sym->name;
+	    }
+
+	  if (s2 && !gfc_compare_interfaces (comp->ts.interface, s2, name, 0, 1,
+					     err, sizeof (err)))
+	    {
+	      gfc_error ("Interface mismatch for procedure-pointer component "
+			 "'%s' in structure constructor at %L: %s",
+			 &cons->expr->where, comp->name, err);
+	      return FAILURE;
+	    }
+	}
+
       if (!comp->attr.pointer || comp->attr.proc_pointer
 	  || cons->expr->expr_type == EXPR_NULL)
 	continue;
@@ -1128,7 +1162,7 @@  resolve_structure_cons (gfc_expr *expr, int init)
       if (!a.pointer && !a.target)
 	{
 	  t = FAILURE;
-	  gfc_error ("The element in the derived type constructor at %L, "
+	  gfc_error ("The element in the structure constructor at %L, "
 		     "for pointer component '%s' should be a POINTER or "
 		     "a TARGET", &cons->expr->where, comp->name);
 	}
@@ -1156,7 +1190,7 @@  resolve_structure_cons (gfc_expr *expr, int init)
 	      || gfc_is_coindexed (cons->expr)))
 	{
 	  t = FAILURE;
-	  gfc_error ("Invalid expression in the derived type constructor for "
+	  gfc_error ("Invalid expression in the structure constructor for "
 		     "pointer component '%s' at %L in PURE procedure",
 		     comp->name, &cons->expr->where);
 	}
Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 178659)
+++ gcc/fortran/primary.c	(working copy)
@@ -2418,7 +2418,10 @@  gfc_match_structure_constructor (gfc_symbol *sym,
 	    }
 
 	  /* Match the current initializer expression.  */
+	  if (this_comp->attr.proc_pointer)
+	    gfc_matching_procptr_assignment = 1;
 	  m = gfc_match_expr (&comp_tail->val);
+	  gfc_matching_procptr_assignment = 0;
 	  if (m == MATCH_NO)
 	    goto syntax;
 	  if (m == MATCH_ERROR)