[Bug fortran/48095] New: [OOP] Invalid assignment to procedure pointer component not rejected

[Bug fortran/48095] New: [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

           Summary: [OOP] Invalid assignment to procedure pointer
                    component not rejected
           Product: gcc
           Version: 4.6.0
            Status: UNCONFIRMED
          Severity: normal
          Priority: P3
         Component: fortran
        AssignedTo: unassigned@gcc.gnu.org
        ReportedBy: janus@gcc.gnu.org


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.

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #1 from janus at gcc dot gnu.org 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.

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #2 from janus at gcc dot gnu.org 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'

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #3 from janus at gcc dot gnu.org 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

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #4 from janus at gcc dot gnu.org 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

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[burnus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

Tobias Burnus <burnus at gcc dot gnu.org> changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
                 CC|                            |burnus at gcc dot gnu.org

--- Comment #5 from Tobias Burnus <burnus at gcc dot gnu.org> 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.

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[burnus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #6 from Tobias Burnus <burnus at gcc dot gnu.org> 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.

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|UNCONFIRMED                 |ASSIGNED
   Last reconfirmed|                            |2011-09-05
         AssignedTo|unassigned at gcc dot       |janus at gcc dot gnu.org
                   |gnu.org                     |
     Ever Confirmed|0                           |1

--- Comment #7 from janus at gcc dot gnu.org 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.

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #8 from janus at gcc dot gnu.org 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)

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

--- Comment #9 from janus at gcc dot gnu.org 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

[Bug fortran/48095] [OOP] Invalid assignment to procedure pointer component not rejected

[janus at gcc dot gnu.org]

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=48095

janus at gcc dot gnu.org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
             Status|ASSIGNED                    |RESOLVED
         Resolution|                            |FIXED

--- Comment #10 from janus at gcc dot gnu.org 2011-09-07 22:24:00 UTC ---
Fixed with r178665. Closing.