Bug 42144 - [OOP] deferred TBPs do not work
Summary: [OOP] deferred TBPs do not work
Status: RESOLVED FIXED
Alias: None
Product: gcc
Classification: Unclassified
Component: fortran (show other bugs)
Version: 4.5.0
: P3 normal
Target Milestone: 4.5.0
Assignee: janus
URL:
Keywords: rejects-valid, wrong-code
Depends on:
Blocks:
 
Reported: 2009-11-22 13:08 UTC by janus
Modified: 2009-12-22 17:52 UTC (History)
2 users (show)

See Also:
Host:
Target:
Build:
Known to work:
Known to fail:
Last reconfirmed: 2009-12-01 09:11:50


Attachments

Note You need to log in before you can comment on or make changes to this bug.
Description janus 2009-11-22 13:08:28 UTC
Reported by Damian Rouson:

module field_module
  implicit none
  private
  public :: field
  type ,abstract :: field 
  end type
end module

module periodic_5th_order_module
  use field_module ,only : field
  implicit none
  type ,extends(field) :: periodic_5th_order
  end type
end module

module field_factory_module
  implicit none
  private
  public :: field_factory
  type, abstract :: field_factory 
  contains 
    procedure(create_interface), deferred :: create 
  end type 
  abstract interface 
    function create_interface(this) 
      use field_module ,only : field
      import :: field_factory
      class(field_factory), intent(in) :: this 
      class(field) ,pointer :: create_interface
    end function
  end interface 
end module
 
module periodic_5th_factory_module
  use field_factory_module , only : field_factory
  implicit none
  private
  public :: periodic_5th_factory
  type, extends(field_factory) :: periodic_5th_factory 
  contains 
    procedure :: create=>new_periodic_5th_order
  end type 
contains
  function new_periodic_5th_order(this) 
    use field_module ,only : field
    use periodic_5th_order_module ,only : periodic_5th_order
    class(periodic_5th_factory), intent(in) :: this
    class(field) ,pointer :: new_periodic_5th_order
  end function
end module

program main 
  use field_module ,only : field 
  use field_factory_module ,only : field_factory
  use periodic_5th_factory_module ,only : periodic_5th_factory
  implicit none 
  class(field) ,pointer :: u ! Burgers solution variable 
  class(field_factory), allocatable :: field_creator 
  allocate (periodic_5th_factory ::  field_creator) 
  u => field_creator%create() 
end program


This gives

undefined reference to `create_interface_'

when linking. 'create_interface' is the abstract interface of the deferred TBP. Instead of calling this, one should do the same as for other TBPs.
Comment 1 janus 2009-11-23 11:41:47 UTC
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 
Comment 2 janus 2009-11-30 23:03:31 UTC
(In reply to comment #0)
> This gives
> 
> undefined reference to `create_interface_'
> 
> when linking. 'create_interface' is the abstract interface of the deferred TBP.
> Instead of calling this, one should do the same as for other TBPs.

One correctly runs into 'select_class_proc' also for deferred TBPs. We just need to suppress the call for the basetype (check for abstract type).
Comment 3 janus 2009-12-01 09:11:50 UTC
This simple patch fixes comment #0 (but not comment #1):

Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c    (revision 154840)
+++ gcc/fortran/trans-expr.c    (working copy)
@@ -1555,6 +1555,10 @@ select_class_proc (gfc_se *se, gfc_class_esym_list
       /* This case has already been added.  */
       if (elist->derived == NULL)
        goto free_elist;
+
+      /* Skip abstract base types.  */
+      if (elist->derived->attr.abstract)
+       goto free_elist;

       /* Run through the chain picking up all the cases that call the
         same procedure.  */
Comment 4 Dominique d'Humieres 2009-12-01 15:19:12 UTC
The patch in comment #3 allows the test in comment #0 to be compiled and run (though I don't know if the executable is valid). However there are still errors at link time for the test in comment #1.
Comment 5 janus 2009-12-01 22:09:18 UTC
Btw: The example in comment #1 is affected by PR41829, which can be avoided by moving the subroutine 'rescale' to the main program. However, this still fails (also with the patch from comment #3):

module foo_module
 implicit none
 private
 public :: foo

 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

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		! undefined reference to ...
 end subroutine
end program 
Comment 6 janus 2009-12-15 22:30:34 UTC
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
Comment 7 janus 2009-12-15 23:02:55 UTC
(In reply to comment #6)
> 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.

Just opened PR42385 for this.
Comment 8 janus 2009-12-17 09:28:45 UTC
Subject: Bug 42144

Author: janus
Date: Thu Dec 17 09:28:25 2009
New Revision: 155305

URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=155305
Log:
gcc/fortran/
2009-12-17 Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42144
	* trans-expr.c (select_class_proc): Skip abstract base types.

gcc/testsuite/
2009-12-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/42144
	* gfortran.dg/dynamic_dispatch_6.f03: New test.

Added:
    trunk/gcc/testsuite/gfortran.dg/dynamic_dispatch_6.f03
Modified:
    trunk/gcc/fortran/ChangeLog
    trunk/gcc/fortran/trans-expr.c
    trunk/gcc/testsuite/ChangeLog

Comment 9 janus 2009-12-17 09:46:03 UTC
Fixed on trunk with r155305 (on fortran-dev it was working already). Closing.