Bug 42385

Summary: [OOP] poylmorphic operators do not work
Product: gcc Reporter: janus
Component: fortranAssignee: Paul Thomas <pault>
Status: RESOLVED FIXED    
Severity: normal CC: anlauf, gcc-bugs, sfilippone
Priority: P3 Keywords: wrong-code
Version: 4.5.0   
Target Milestone: ---   
Host: Target:
Build: Known to work:
Known to fail: Last reconfirmed:
Attachments: additional test-case
Fix for the PR

Description janus 2009-12-15 23:01:10 UTC
Spin-off from PR 42144 (comment #6). As the following code demonstrates, polymorphic type-bound operators are buggy:


module foo_module
 implicit none
 private
 public :: foo

 type :: foo
 contains
   procedure :: times => times_foo
   procedure :: assign => assign_foo
   generic :: operator(*) => times
   generic :: assignment(=) => assign
 end type

contains

   function times_foo(this,factor) result(product)
     class(foo) ,intent(in) :: this
     class(foo) ,allocatable :: product
     real, intent(in) :: factor
   end function

   subroutine assign_foo(lhs,rhs)
     class(foo) ,intent(inout) :: lhs
     class(foo) ,intent(in) :: rhs
   end subroutine

end module

module bar_module
 use foo_module ,only : foo
 implicit none
 private
 public :: bar

 type ,extends(foo) :: bar
   private
   real :: x=1.
 contains
   procedure :: times => times_bar
   procedure :: assign => assign_bar
 end type

contains
 subroutine assign_bar(lhs,rhs)
   class(bar) ,intent(inout) :: lhs
   class(foo) ,intent(in) :: rhs
   select type(rhs)
     type is (bar)
       lhs%x = rhs%x
   end select
 end subroutine
 function times_bar(this,factor) result(product)
   class(bar) ,intent(in) :: this
   real, intent(in) :: factor
   class(foo), allocatable :: product
   select type(this)
     type is (bar)
       allocate(product,source=this)
       select type(product)
         type is(bar)
           product%x = this%x*factor
       end select
   end select
 end function
end module

program main
 use foo_module ,only : foo
 use bar_module ,only : bar
 implicit none
 type(bar) :: unit
 call rescale(unit,3.141592654)
contains
 subroutine rescale(this,scale)
   class(foo) ,intent(inout) :: this
   real, intent(in) :: scale
   this = this*scale
 end subroutine
end program


This test case is compiled flawlessly, but the generated code is wrong:

rescale (struct .class.foo & restrict this, real(kind=4) & restrict scale)
{
  {
    struct .class.foo.a D.1631;

    D.1631 = times_foo ((struct .class.foo *) this, (real(kind=4) *) scale);
    assign_foo ((struct .class.foo *) this, &D.1631);
  }
}

The operators are always resolved to the base-class procedures. Polymorphic treatment is missing.
Comment 1 Damian Rouson 2010-05-21 14:01:42 UTC
As suggested by Janus and Paul, I'm adding the additional test case below. Note that the first two pointer assignments in main are not necessary to demonstrate the linking problem. I put them there (1) to give more detail about what I was trying to do and (2) because deleting those leaves pointless code since there would be no reason to do the the third assignment without doing the first two.

$cat link_demo.f03
module field_module
  implicit none

  type ,abstract :: field 
  contains
    procedure(field_eq_field) ,deferred :: assign         
    generic :: assignment(=) => assign
  end type
    
  abstract interface
    subroutine field_eq_field(lhs,rhs)
      import :: field
      class(field) ,intent(out) :: lhs
      class(field) ,intent(in) :: rhs
    end subroutine
  end interface 
end module
module periodic_field_module
  use field_module ,only : field
  implicit none

  type ,extends(field) :: periodic_field
    real :: f=0.
  contains
    procedure :: assign => copy
  end type

contains
  function new_periodic_field()
    type(periodic_field) ,pointer :: new_periodic_field
    allocate(new_periodic_field)
  end function

  subroutine copy(lhs,rhs)
    class(field) ,intent(in) :: rhs
    class(periodic_field) ,intent(out) :: lhs
    select type(rhs)
      class is (periodic_field)
        lhs%f = rhs%f
      class default
        stop 'periodic_field%copy: unsupported right-hand-side class.'
    end select
  end subroutine
end module
program main
  use field_module 
  use periodic_field_module 
  implicit none
  class(field) ,pointer :: u,f
  u => new_periodic_field() 
  f => new_periodic_field()
  f = u
end program

$ gfortran link_demo.f03 
Undefined symbols:
  "_field_eq_field_", referenced from:
      _MAIN__ in ccFO42I9.o
ld: symbol(s) not found
collect2: ld returned 1 exit status
Comment 2 Salvatore Filippone 2010-07-12 14:58:47 UTC
(In reply to comment #1)
Hi Damian,
This is related to the original test case for PR 43945; that test case is now going to handle the dynamic side of it, but the problem with generics exists with normal typebound procedures as well. It seems to be related to the binding_name => specific_name thing, operators are not really relevant. 
Comment 3 Salvatore Filippone 2010-07-12 14:59:22 UTC
Created attachment 21184 [details]
additional test-case
Comment 4 Tobias Burnus 2010-07-13 09:17:54 UTC
Carry on the test case from PR 43945 comment 19 (cf. also PR 43945 comment 30, 31, 32):

Salvatore wrote:
> Yup, but after discussion with Janus, it seems the failing part is not
> dynamic dispatching, but compile-time resolution. Accordingly, I have
> appended the test case to PR 42385.

As the test case in comment 3 (attachment 21184 [details]) is different from the one of PR 43945 comment 19, I add the latter as well:

Attachment 20927 [details]  compiles with both crayftn and gfortran, but the run-time result is different; while crayftn has

 Allocated COO succesfully, should now set components
 STOP

with gfortran the result is

 Error: Missing ovverriding impl for allocate in class COO
Comment 5 Salvatore Filippone 2010-07-13 09:24:16 UTC
(In reply to comment #4)
> Carry on the test case from PR 43945 comment 19 (cf. also PR 43945 comment 30,
> 31, 32):
> 
> 
> As the test case in comment 3 (attachment 21184 [details] [edit]) is different from the one of
> PR 43945 comment 19, I add the latter as well:
> 
> Attachment 20927 [details] [edit]  compiles with both crayftn and gfortran, but the run-time
> result is different; while crayftn has
> 
>  Allocated COO succesfully, should now set components
>  STOP
> 
> with gfortran the result is
> 
>  Error: Missing ovverriding impl for allocate in class COO
> 

The two are intended to generate the same error, i.e. resolution to the base specific instead of the overriding one. As far as I can tell the error is caused by having a binding-name => specific-name in the base version; if the base version has just a name (thus binding==specific) the resolution mechanism works.

Salvatore 
Comment 6 Tobias Burnus 2010-07-14 21:43:08 UTC
The test cases in comment 3 (attachment 21184 [details]) and comment 4 (attachment 20927 [details]) are now tracked in PR 44936 - and fixed by the draft patch there.

The original test case (comment 0) still generates wrong code and the test from comment 1 still does compile.
Comment 7 Paul Thomas 2010-07-16 13:20:20 UTC
Created attachment 21221 [details]
Fix for the PR

Please note that this patch contains part of Janus' clean-up of vtabs diff.  This came about because the tree on my laptop is too old.

I will separate out the fix for PR42385 tonight.

It bootstraps and regtests on RHEL5.3/i686.

Paul

The following runs correctly:
module foo_module
 implicit none
 private
 public :: foo

 type :: foo
   integer :: i
 contains
   procedure :: times => times_foo
   procedure :: assign => assign_foo
   generic :: operator(*) => times
   generic :: assignment(=) => assign
 end type

contains

   function times_foo(this,factor) result(product)
     class(foo) ,intent(in) :: this
     class(foo) ,pointer :: product
     real, intent(in) :: factor
     allocate (product, source = this)
     product%i = this%i * int (factor)
   end function

   subroutine assign_foo(lhs,rhs)
     class(foo) ,intent(inout) :: lhs
     class(foo) ,intent(in) :: rhs
     lhs%i = rhs%i
    end subroutine

end module

module bar_module
 use foo_module ,only : foo
 implicit none
 private
 public :: bar

 type ,extends(foo) :: bar
   real :: x
 contains
   procedure :: times => times_bar
   procedure :: assign => assign_bar
 end type

contains
 subroutine assign_bar(lhs,rhs)
   class(bar) ,intent(inout) :: lhs
   class(foo) ,intent(in) :: rhs
   lhs%i = rhs%i
   select type(rhs)
     type is (bar)
       lhs%x = rhs%x
   end select
 end subroutine
 function times_bar(this,factor) result(product)
   class(bar) ,intent(in) :: this
   real, intent(in) :: factor
   class(foo), pointer :: product
   select type(this)
     type is (bar)
       allocate(product,source=this)
       select type(product)
         type is(bar)
           product%i = this%i*int(factor)
           product%x = this%x*factor
       end select
   end select
 end function
end module

program main
 use foo_module ,only : foo
 use bar_module ,only : bar
 implicit none
 type(foo) :: uniti = foo(2) 
 type(bar) :: unitx = bar(2, 1.0)
 call rescale(uniti, 3.141592654)
 call rescale(unitx, 3.141592654)
 print *, uniti%i
 print *, unitx%x, unitx%i
contains
 subroutine rescale(this,scale)
   class(foo) ,intent(inout) :: this
   real, intent(in) :: scale
   this = this*scale
 end subroutine
end program
Comment 8 Paul Thomas 2010-07-19 18:49:01 UTC
Subject: Bug 42385

Author: pault
Date: Mon Jul 19 18:48:44 2010
New Revision: 162313

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=162313
Log:
2010-07-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/42385
	* interface.c (matching_typebound_op): Add argument for the
	return of the generic name for the procedure.
	(build_compcall_for_operator): Add an argument for the generic
	name of an operator procedure and supply it to the expression.
	(gfc_extend_expr, gfc_extend_assign): Use the generic name in
	calls to the above procedures.
	* resolve.c (resolve_typebound_function): Catch procedure
	component calls for CLASS objects, check that the vtable is
	complete and insert the $vptr and procedure components, to make
	the call.
	(resolve_typebound_function): The same.
	* trans-decl.c (gfc_trans_deferred_vars): Do not deallocate
	an allocatable scalar if it is a result.


2010-07-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/42385
	* gfortran.dg/class_defined_operator_1.f03 : New test.


Added:
    trunk/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/interface.c
    trunk/gcc/fortran/resolve.c
    trunk/gcc/fortran/trans-decl.c
    trunk/gcc/testsuite/ChangeLog

Comment 9 paul.richard.thomas@gmail.com 2010-07-19 20:12:39 UTC
Subject: Re:  [OOP] poylmorphic operators do not work

Fixed on trunk

Paul

> Author: pault
> Date: Mon Jul 19 18:48:44 2010
> New Revision: 162313
>
> URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=162313
> Log:
> 2010-07-19  Paul Thomas  <pault@gcc.gnu.org>
>
>        PR fortran/42385
>        * interface.c (matching_typebound_op): Add argument for the
>        return of the generic name for the procedure.
>        (build_compcall_for_operator): Add an argument for the generic
>        name of an operator procedure and supply it to the expression.
>        (gfc_extend_expr, gfc_extend_assign): Use the generic name in
>        calls to the above procedures.
>        * resolve.c (resolve_typebound_function): Catch procedure
>        component calls for CLASS objects, check that the vtable is
>        complete and insert the $vptr and procedure components, to make
>        the call.
>        (resolve_typebound_function): The same.
>        * trans-decl.c (gfc_trans_deferred_vars): Do not deallocate
>        an allocatable scalar if it is a result.
>
>
> 2010-07-19  Paul Thomas  <pault@gcc.gnu.org>
>
>        PR fortran/42385
>        * gfortran.dg/class_defined_operator_1.f03 : New test.
Comment 10 Tobias Burnus 2010-07-20 08:09:11 UTC
(In reply to comment #9)
> Fixed on trunk

Really close as FIXED. Thanks for the patch.