[Bug fortran/42144] [OOP] deferred TBPs do not work

[janus at gcc dot gnu dot org]

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