------- Comment #6 from janus at gcc dot gnu dot org  2009-12-15 22:30 -------
The test case in comment #5 has issues which go beyond the usage of 'deferred':
The variant below, which has no deferred procedures, compiles, but produces
wrong code (the operators are always resolved to the TBPs of the base type,
although they should be polymorphic). This should go into a separate PR.

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


-- 


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

Reply via email to