------- 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
