diff mbox

[Fortran,F03] PR77596: procedure pointer component with implicit interface can point to a function

Message ID CAKwh3qhxZvdbyCHN49Kum_dmiC9bnKcEhCw64b0nU5VkgiM8sw@mail.gmail.com
State New
Headers show

Commit Message

Janus Weil Nov. 8, 2016, 10:02 a.m. UTC 
Hi all,

here is a simple patch for the accepts-invalid problem of PR77596.
Regtests cleanly on x86_64-linux-gnu. Ok for trunk?

Cheers,
Janus


2016-11-08  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/77596
    * expr.c (gfc_check_pointer_assign): Add special check for procedure-
    pointer component with absent interface.

2016-11-08  Janus Weil  <janus@gcc.gnu.org>

    PR fortran/77596
    * gfortran.dg/proc_ptr_comp_46.f90: New test.

Comments

Steve Kargl Nov. 8, 2016, 2:51 p.m. UTC | #1 
On Tue, Nov 08, 2016 at 11:02:26AM +0100, Janus Weil wrote:
> 
> here is a simple patch for the accepts-invalid problem of PR77596.
> Regtests cleanly on x86_64-linux-gnu. Ok for trunk?
> 

Yes.  (and welcome back to the wonderful world of bugzilla).
Janus Weil Nov. 8, 2016, 4:26 p.m. UTC | #2 
2016-11-08 15:51 GMT+01:00 Steve Kargl <sgk@troutmask.apl.washington.edu>:
> On Tue, Nov 08, 2016 at 11:02:26AM +0100, Janus Weil wrote:
>>
>> here is a simple patch for the accepts-invalid problem of PR77596.
>> Regtests cleanly on x86_64-linux-gnu. Ok for trunk?
>>
>
> Yes.

Thanks! Committed as r241972.


> (and welcome back to the wonderful world of bugzilla).

:)

In fact I hope to be able to devote quite a bit of time to gfortran in
the coming weeks (and will probably start with some low-hanging fruit,
in order warm up after a longer absence).

Cheers,
Janus
diff mbox

Patch

Index: gcc/fortran/expr.c
===================================================================
--- gcc/fortran/expr.c	(Revision 241956)
+++ gcc/fortran/expr.c	(Arbeitskopie)
@@ -3445,7 +3445,7 @@  gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
     {
       char err[200];
       gfc_symbol *s1,*s2;
-      gfc_component *comp;
+      gfc_component *comp1, *comp2;
       const char *name;
 
       attr = gfc_expr_attr (rvalue);
@@ -3549,9 +3549,9 @@  gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
 	    }
 	}
 
-      comp = gfc_get_proc_ptr_comp (lvalue);
-      if (comp)
-	s1 = comp->ts.interface;
+      comp1 = gfc_get_proc_ptr_comp (lvalue);
+      if (comp1)
+	s1 = comp1->ts.interface;
       else
 	{
 	  s1 = lvalue->symtree->n.sym;
@@ -3559,18 +3559,18 @@  gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
 	    s1 = s1->ts.interface;
 	}
 
-      comp = gfc_get_proc_ptr_comp (rvalue);
-      if (comp)
+      comp2 = gfc_get_proc_ptr_comp (rvalue);
+      if (comp2)
 	{
 	  if (rvalue->expr_type == EXPR_FUNCTION)
 	    {
-	      s2 = comp->ts.interface->result;
+	      s2 = comp2->ts.interface->result;
 	      name = s2->name;
 	    }
 	  else
 	    {
-	      s2 = comp->ts.interface;
-	      name = comp->name;
+	      s2 = comp2->ts.interface;
+	      name = comp2->name;
 	    }
 	}
       else if (rvalue->expr_type == EXPR_FUNCTION)
@@ -3591,6 +3591,15 @@  gfc_check_pointer_assign (gfc_expr *lvalue, gfc_ex
       if (s2 && s2->attr.proc_pointer && s2->ts.interface)
 	s2 = s2->ts.interface;
 
+      /* Special check for the case of absent interface on the lvalue.
+       * All other interface checks are done below. */
+      if (!s1 && comp1 && comp1->attr.subroutine && s2 && s2->attr.function)
+	{
+	  gfc_error ("Interface mismatch in procedure pointer assignment "
+		     "at %L: '%s' is not a subroutine", &rvalue->where, name);
+	  return false;
+	}
+
       if (s1 == s2 || !s1 || !s2)
 	return true;