[Bug fortran/42385] [OOP] poylmorphic operators do not work

["pault at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

------- Comment #7 from pault at gcc dot gnu dot org  2010-07-16 13:20 -------
Created an attachment (id=21221)
 --> (http://gcc.gnu.org/bugzilla/attachment.cgi?id=21221&action=view)
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


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |pault at gcc dot gnu dot org
                   |dot org                     |
             Status|UNCONFIRMED                 |ASSIGNED


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