Bug 64508 - [F03] interface check missing for procedure pointer component as actual argument
Summary: [F03] interface check missing for procedure pointer component as actual argument
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 5.0
: P3 normal
Target Milestone: ---
Assignee: janus
URL:
Keywords: accepts-invalid
Depends on:
Blocks:
 
Reported: 2015-01-06 10:11 UTC by janus
Modified: 2015-01-11 17:35 UTC (History)
0 users

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2015-01-06 00:00:00


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description janus 2015-01-06 10:11:02 UTC
Inspired by the discussion at:

https://groups.google.com/forum/?fromgroups=#!topic/comp.lang.fortran/svfanCGU2vU

Example code:


module m

   TYPE :: parent
   END TYPE parent

   TYPE, EXTENDS(parent) :: extension
     INTEGER :: extension_component = 0
      procedure(extension_proc), pointer :: ppc
   END TYPE extension

contains

   SUBROUTINE parent_proc(arg)
     CLASS(parent), INTENT(IN) :: arg
     PRINT *, 'I am parent_proc'
   END SUBROUTINE parent_proc

   SUBROUTINE extension_proc(arg)
     CLASS(extension), INTENT(IN) :: arg
     PRINT *, 'I am extension_proc'
     PRINT *, arg%extension_component
   END SUBROUTINE extension_proc

   SUBROUTINE some_proc(proc)
     PROCEDURE(parent_proc) :: proc
     TYPE(Parent) :: a
     CALL proc(a)
   END SUBROUTINE some_proc

end module

program test
  use m
   CLASS(extension), ALLOCATABLE :: x
   procedure(parent_proc), pointer :: ppp
   procedure(extension_proc), pointer :: ppe

   CALL some_proc(parent_proc)     ! ok
   CALL some_proc(extension_proc)  ! interface mismatch

   ppp => extension_proc           ! interface mismatch
   call some_proc(ppp)

   ppe => extension_proc
   call some_proc(ppe)             ! interface mismatch

   allocate(x, source= Extension(666,extension_proc))
   CALL some_proc(x%ppc)           !  XXX: mismatch not detected
end



As the above example shows, interface checking is done for ordinary procedures and procedure pointers as actual arguments to dummy procedures. However, it is missing for procedure-pointer components.
Comment 1 janus 2015-01-06 12:38:34 UTC
Draft patch (regtest cleanly):


Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(Revision 219257)
+++ gcc/fortran/interface.c	(Arbeitskopie)
@@ -1922,6 +1922,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
 {
   gfc_ref *ref;
   bool rank_check, is_pointer;
+  char err[200];
+  gfc_component *ppc;
 
   /* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
      procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -1942,7 +1944,6 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
 
   if (actual->ts.type == BT_PROCEDURE)
     {
-      char err[200];
       gfc_symbol *act_sym = actual->symtree->n.sym;
 
       if (formal->attr.flavor != FL_PROCEDURE)
@@ -1976,6 +1977,19 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
       return 1;
     }
 
+  ppc = gfc_get_proc_ptr_comp (actual);
+  if (ppc)
+    {
+      if (!gfc_compare_interfaces (formal, ppc->ts.interface, ppc->name, 0, 1,
+				   err, sizeof(err), NULL, NULL))
+	{
+	  if (where)
+	    gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s",
+		       formal->name, &actual->where, err);
+	  return 0;
+	}
+    }
+
   /* F2008, C1241.  */
   if (formal->attr.pointer && formal->attr.contiguous
       && !gfc_is_simply_contiguous (actual, true))
Comment 2 janus 2015-01-11 17:31:55 UTC
Author: janus
Date: Sun Jan 11 17:31:22 2015
New Revision: 219431

URL: https://gcc.gnu.org/viewcvs?rev=219431&root=gcc&view=rev
Log:
2015-01-11  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/64508
	* interface.c (compare_parameter): Interface check for
	procedure-pointer component as actual argument.

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

	PR fortran/64508
	* gfortran.dg/proc_ptr_comp_41.f90: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/proc_ptr_comp_41.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/interface.c
    trunk/gcc/testsuite/ChangeLog
Comment 3 janus 2015-01-11 17:34:49 UTC
Fixed with r219431. Closing.
Comment 4 janus 2015-01-11 17:35:34 UTC
Actually closing.