Spin-off from PR 42144 (comment #6). As the following code demonstrates, polymorphic type-bound operators are buggy: 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 This test case is compiled flawlessly, but the generated code is wrong: rescale (struct .class.foo & restrict this, real(kind=4) & restrict scale) { { struct .class.foo.a D.1631; D.1631 = times_foo ((struct .class.foo *) this, (real(kind=4) *) scale); assign_foo ((struct .class.foo *) this, &D.1631); } } The operators are always resolved to the base-class procedures. Polymorphic treatment is missing.
As suggested by Janus and Paul, I'm adding the additional test case below. Note that the first two pointer assignments in main are not necessary to demonstrate the linking problem. I put them there (1) to give more detail about what I was trying to do and (2) because deleting those leaves pointless code since there would be no reason to do the the third assignment without doing the first two. $cat link_demo.f03 module field_module implicit none type ,abstract :: field contains procedure(field_eq_field) ,deferred :: assign generic :: assignment(=) => assign end type abstract interface subroutine field_eq_field(lhs,rhs) import :: field class(field) ,intent(out) :: lhs class(field) ,intent(in) :: rhs end subroutine end interface end module module periodic_field_module use field_module ,only : field implicit none type ,extends(field) :: periodic_field real :: f=0. contains procedure :: assign => copy end type contains function new_periodic_field() type(periodic_field) ,pointer :: new_periodic_field allocate(new_periodic_field) end function subroutine copy(lhs,rhs) class(field) ,intent(in) :: rhs class(periodic_field) ,intent(out) :: lhs select type(rhs) class is (periodic_field) lhs%f = rhs%f class default stop 'periodic_field%copy: unsupported right-hand-side class.' end select end subroutine end module program main use field_module use periodic_field_module implicit none class(field) ,pointer :: u,f u => new_periodic_field() f => new_periodic_field() f = u end program $ gfortran link_demo.f03 Undefined symbols: "_field_eq_field_", referenced from: _MAIN__ in ccFO42I9.o ld: symbol(s) not found collect2: ld returned 1 exit status
(In reply to comment #1) Hi Damian, This is related to the original test case for PR 43945; that test case is now going to handle the dynamic side of it, but the problem with generics exists with normal typebound procedures as well. It seems to be related to the binding_name => specific_name thing, operators are not really relevant.
Created attachment 21184 [details] additional test-case
Carry on the test case from PR 43945 comment 19 (cf. also PR 43945 comment 30, 31, 32): Salvatore wrote: > Yup, but after discussion with Janus, it seems the failing part is not > dynamic dispatching, but compile-time resolution. Accordingly, I have > appended the test case to PR 42385. As the test case in comment 3 (attachment 21184 [details]) is different from the one of PR 43945 comment 19, I add the latter as well: Attachment 20927 [details] compiles with both crayftn and gfortran, but the run-time result is different; while crayftn has Allocated COO succesfully, should now set components STOP with gfortran the result is Error: Missing ovverriding impl for allocate in class COO
(In reply to comment #4) > Carry on the test case from PR 43945 comment 19 (cf. also PR 43945 comment 30, > 31, 32): > > > As the test case in comment 3 (attachment 21184 [details] [edit]) is different from the one of > PR 43945 comment 19, I add the latter as well: > > Attachment 20927 [details] [edit] compiles with both crayftn and gfortran, but the run-time > result is different; while crayftn has > > Allocated COO succesfully, should now set components > STOP > > with gfortran the result is > > Error: Missing ovverriding impl for allocate in class COO > The two are intended to generate the same error, i.e. resolution to the base specific instead of the overriding one. As far as I can tell the error is caused by having a binding-name => specific-name in the base version; if the base version has just a name (thus binding==specific) the resolution mechanism works. Salvatore
The test cases in comment 3 (attachment 21184 [details]) and comment 4 (attachment 20927 [details]) are now tracked in PR 44936 - and fixed by the draft patch there. The original test case (comment 0) still generates wrong code and the test from comment 1 still does compile.
Created attachment 21221 [details] 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
Subject: Bug 42385 Author: pault Date: Mon Jul 19 18:48:44 2010 New Revision: 162313 URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=162313 Log: 2010-07-19 Paul Thomas <pault@gcc.gnu.org> PR fortran/42385 * interface.c (matching_typebound_op): Add argument for the return of the generic name for the procedure. (build_compcall_for_operator): Add an argument for the generic name of an operator procedure and supply it to the expression. (gfc_extend_expr, gfc_extend_assign): Use the generic name in calls to the above procedures. * resolve.c (resolve_typebound_function): Catch procedure component calls for CLASS objects, check that the vtable is complete and insert the $vptr and procedure components, to make the call. (resolve_typebound_function): The same. * trans-decl.c (gfc_trans_deferred_vars): Do not deallocate an allocatable scalar if it is a result. 2010-07-19 Paul Thomas <pault@gcc.gnu.org> PR fortran/42385 * gfortran.dg/class_defined_operator_1.f03 : New test. Added: trunk/gcc/testsuite/gfortran.dg/class_defined_operator_1.f03 Modified: trunk/gcc/fortran/ChangeLog trunk/gcc/fortran/interface.c trunk/gcc/fortran/resolve.c trunk/gcc/fortran/trans-decl.c trunk/gcc/testsuite/ChangeLog
Subject: Re: [OOP] poylmorphic operators do not work Fixed on trunk Paul > Author: pault > Date: Mon Jul 19 18:48:44 2010 > New Revision: 162313 > > URL: http://gcc.gnu.org/viewcvs?root=gcc&view=rev&rev=162313 > Log: > 2010-07-19 Paul Thomas <pault@gcc.gnu.org> > > PR fortran/42385 > * interface.c (matching_typebound_op): Add argument for the > return of the generic name for the procedure. > (build_compcall_for_operator): Add an argument for the generic > name of an operator procedure and supply it to the expression. > (gfc_extend_expr, gfc_extend_assign): Use the generic name in > calls to the above procedures. > * resolve.c (resolve_typebound_function): Catch procedure > component calls for CLASS objects, check that the vtable is > complete and insert the $vptr and procedure components, to make > the call. > (resolve_typebound_function): The same. > * trans-decl.c (gfc_trans_deferred_vars): Do not deallocate > an allocatable scalar if it is a result. > > > 2010-07-19 Paul Thomas <pault@gcc.gnu.org> > > PR fortran/42385 > * gfortran.dg/class_defined_operator_1.f03 : New test.
(In reply to comment #9) > Fixed on trunk Really close as FIXED. Thanks for the patch.