------- Comment #1 from janus at gcc dot gnu dot org 2009-11-23 11:41 -------
Another example (with generics):
module foo_module
implicit none
private
public :: foo,rescale
type ,abstract :: foo
contains
procedure(times_interface) ,deferred :: times
procedure(assign_interface) ,deferred :: assign
generic :: operator(*) => times
generic :: assignment(=) => assign
end type
abstract interface
function times_interface(this,factor) result(product)
import :: foo
class(foo) ,intent(in) :: this
class(foo) ,allocatable :: product
real, intent(in) :: factor
end function
subroutine assign_interface(lhs,rhs)
import :: foo
class(foo) ,intent(inout) :: lhs
class(foo) ,intent(in) :: rhs
end subroutine
end interface
contains
subroutine rescale(this,scale)
class(foo) ,intent(inout) :: this
real, intent(in) :: scale
this = this*scale
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,rescale
use bar_module ,only : bar
implicit none
type(bar) :: unit
call rescale(unit,3.141592654)
end program
--
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=42144
