Bug 48095 - [OOP] Invalid assignment to procedure pointer component not rejected
Summary: [OOP] Invalid assignment to procedure pointer component not rejected
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.6.0
: P3 normal
Target Milestone: ---
Assignee: janus
URL:
Keywords:
Depends on:
Blocks:
 
Reported: 2011-03-12 17:32 UTC by janus
Modified: 2011-09-07 22:24 UTC (History)
1 user (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2011-09-05 00:00:00


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description janus 2011-03-12 17:32:49 UTC
Reported by Arjen Markus at http://gcc.gnu.org/ml/fortran/2011-03/msg00057.html:

The following program (slightly modified from the original) does not produce the expected result:


module proc_pointers

  implicit none

  type :: rectangle
    real :: width, height
    procedure(get_area), pointer, pass(this) :: get_special_area => get_my_area
  end type rectangle

  abstract interface
    real function get_area( this )
      import                       :: rectangle
      class(rectangle), intent(in) :: this
    end function get_area
  end interface

contains

  real function get_my_area( this )
    type(rectangle), intent(in) :: this
    write(*,*) 'This: ', this%width, this%height
    get_my_area = 3.0 * this%width * this%height
  end function get_my_area

end module proc_pointers


program test_objects

   use proc_pointers
   implicit none

   type(rectangle) :: rect
   real            :: area

   rect  = rectangle (1.0,2.0)
   write(*,*) 'Rect: ', rect%width, rect%height
   area = rect%get_special_area()
   write(*,*) 'Special area:', area

end program test_objects


I think it is invalid, because the PPC 'get_special_area' is declared to expect a CLASS argument, but then the procedure it points to has a TYPE argument.

One should check the standard on this.
Comment 1 janus 2011-03-12 17:46:44 UTC
(In reply to comment #0)
> I think it is invalid, because the PPC 'get_special_area' is declared to expect
> a CLASS argument, but then the procedure it points to has a TYPE argument.
> 
> One should check the standard on this.

The relevant F08 quote is:

"7.2.2.4 Procedure pointer assignment"
[...]
"If the pointer object has an explicit interface, its characteristics shall be
the same as the pointer target except that the pointer target may be pure even
if the pointer object is not pure and the pointer target may be an elemental
intrinsic procedure even if the pointer object is not elemental."


cf. also PR 46990 comment 6.
Comment 2 janus 2011-03-26 21:07:42 UTC
The following variant is correctly being rejected:


  implicit none

  type :: rectangle
    real :: width, height
    procedure(get_area), pointer, pass(this) :: get_special_area
  end type rectangle

  abstract interface
    real function get_area( this )
      import                       :: rectangle
      class(rectangle), intent(in) :: this
    end function get_area
  end interface

   type(rectangle) :: rect

   rect%get_special_area => get_my_area

contains

  real function get_my_area( this )
    type(rectangle), intent(in) :: this
    write(*,*) 'This: ', this%width, this%height
    get_my_area = 3.0 * this%width * this%height
  end function get_my_area

end



   rect%get_special_area => get_my_area
                            1
Error: Interface mismatch in procedure pointer assignment at (1): Type/rank mismatch in argument 'this'
Comment 3 janus 2011-03-28 20:55:13 UTC
Also the following variant is not rejected (seems to be a module problem):


module m

  implicit none

  type :: rectangle
    real :: width, height
    procedure(get_area), pointer, pass(this) :: get_special_area
  end type rectangle

  abstract interface
    real function get_area( this )
      import                       :: rectangle
      class(rectangle), intent(in) :: this
    end function get_area
  end interface

  type(rectangle) :: rect

contains

  real function get_my_area( this )
    type(rectangle), intent(in) :: this
    write(*,*) 'This: ', this%width, this%height
    get_my_area = 3.0 * this%width * this%height
  end function get_my_area

end module


use m
rect%get_special_area => get_my_area  
end
Comment 4 janus 2011-03-29 09:39:13 UTC
Author: janus
Date: Tue Mar 29 09:39:10 2011
New Revision: 171654

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=171654
Log:
2011-03-29  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/48095
	* decl.c (match_procedure_decl,match_ppc_decl): Set flavor of interface.
	* module.c (MOD_VERSION): Bump.
	(mio_typespec): Read/write 'interface' field.
	* primary.c (match_string_constant,match_logical_constant): Remove
	unneeded code.
	(match_complex_constant): Make sure to clear the typespec.

2011-03-29  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/48095
	* gfortran.dg/module_md5_1.f90: Modified MD5 sum.
	* gfortran.dg/proc_ptr_comp_32.f90: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/proc_ptr_comp_32.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/decl.c
    trunk/gcc/fortran/module.c
    trunk/gcc/fortran/primary.c
    trunk/gcc/testsuite/ChangeLog
    trunk/gcc/testsuite/gfortran.dg/module_md5_1.f90
Comment 5 Tobias Burnus 2011-03-29 10:10:40 UTC
Remains to be done: The test case of comment 0. Seemingly, for an initialization, the check is not done - while for a normal pointer assignment it is (in expr.c's gfc_check_pointer_assign).

I would assume that one needs a similar check in resolve_structure_cons. There are already checks for "pointer initialization" - one probably needs needs to add a similar check to the one in gfc_check_pointer_assign.
Comment 6 Tobias Burnus 2011-03-29 10:19:02 UTC
(In reply to comment #5)
> I would assume that one needs a similar check in resolve_structure_cons.

That should then also take care of:

  rect = rectangle (1.0, 2.0, get_my_area)

which had the same issue, except that it is currently rejected with:

  Error: Function 'get_my_area' requires an argument list at (1)

However, if I read the standard correctly (F2008, 4.5.10 Construction of derived-type values), it should be valid:

  R456 component-spec  is  [ keyword = ] component-data-source
  R457 component-data-source  is  expr
                              or  data-target
                              or  proc-target
  R740 proc-target  is  expr
                    or  procedure-name
                    or  proc-component-ref

  C497 (R457) A data-target shall correspond to a data pointer component;
              a proc-target shall correspond to a procedure pointer component.
Comment 7 janus 2011-09-05 12:45:58 UTC
(In reply to comment #5)
> Remains to be done: The test case of comment 0. Seemingly, for an
> initialization, the check is not done - while for a normal pointer assignment
> it is (in expr.c's gfc_check_pointer_assign).
> 
> I would assume that one needs a similar check in resolve_structure_cons. There
> are already checks for "pointer initialization" - one probably needs needs to
> add a similar check to the one in gfc_check_pointer_assign.

Right. In principle it would be nice to share the code, e.g. by calling gfc_check_pointer_assign from resolve_structure_cons. But I'm not sure if there is an easy way to accomplish this. Otherwise one could just add the check manually in resolve_structure_cons:


Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 178527)
+++ gcc/fortran/resolve.c	(working copy)
@@ -1119,6 +1119,39 @@ resolve_structure_cons (gfc_expr *expr, int init)
 		     comp->name);
 	}
 
+      if (comp->attr.proc_pointer && comp->ts.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 ("In derived type constructor at %L: Interface mismatch"
+			 " in procedure pointer component '%s': %s",
+			 &cons->expr->where, comp->name, err);
+	      return FAILURE;
+	    }
+	}
+
       if (!comp->attr.pointer || comp->attr.proc_pointer
 	  || cons->expr->expr_type == EXPR_NULL)
 	continue;



This patch regtests cleanly on x86_64-unknown-linux-gnu.
Comment 8 janus 2011-09-05 13:14:27 UTC
(In reply to comment #6)
> That should then also take care of:
> 
>   rect = rectangle (1.0, 2.0, get_my_area)
> 
> which had the same issue, except that it is currently rejected with:
> 
>   Error: Function 'get_my_area' requires an argument list at (1)
> 
> However, if I read the standard correctly (F2008, 4.5.10 Construction of
> derived-type values), it should be valid:

Yes. The false error demanding an argument list is cured by:


Index: gcc/fortran/primary.c
===================================================================
--- gcc/fortran/primary.c	(revision 178527)
+++ 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)
Comment 9 janus 2011-09-07 22:20:50 UTC
Author: janus
Date: Wed Sep  7 22:20:47 2011
New Revision: 178665

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=178665
Log:
2011-09-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/48095
	* primary.c (gfc_match_structure_constructor): Handle parsing of
	procedure pointers components in structure constructors.
	* resolve.c (resolve_structure_cons): Check interface of procedure
	pointer components. Changed wording of some error messages.


2011-09-07  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/48095
	* gfortran.dg/derived_constructor_comps_2.f90: Modified.
	* gfortran.dg/impure_constructor_1.f90: Modified.
	* gfortran.dg/proc_ptr_comp_33.f90: New.

Added:
    trunk/gcc/testsuite/gfortran.dg/proc_ptr_comp_33.f90
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/primary.c
    trunk/gcc/fortran/resolve.c
    trunk/gcc/testsuite/ChangeLog
    trunk/gcc/testsuite/gfortran.dg/derived_constructor_comps_2.f90
    trunk/gcc/testsuite/gfortran.dg/impure_constructor_1.f90
Comment 10 janus 2011-09-07 22:24:00 UTC
Fixed with r178665. Closing.