Dear all,
if one uses TYPE(extended), the overridden specific procedure
("trace_ext" to the TBP "trace") associated with an operator (".tr.") is
not called - but the TBP of the base type. It correctly works for
polymorphic types.
Build and regtested on x86-64-linux.
OK for the trunk?
As it is a nasty wrong-code bug (but no regression), I wonder whether it
should be backported - and, if so, to which version - 4.7 only?
(Affected are GCC 4.5 to 4.8.)
Tobias
2012-05-06 Tobias Burnus <bur...@net-b.de>
PR fortran/53255
* resolve.c (resolve_typebound_static): Fix handling
of overridden specific to generic operator.
2012-05-06 Tobias Burnus <bur...@net-b.de>
PR fortran/53255
* gfortran.dg/typebound_operator_15.f90: New.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index e5a49bc..cacc033 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5671,12 +5702,11 @@ resolve_typebound_static (gfc_expr* e, gfc_symtree** target,
e->value.compcall.actual = NULL;
/* If we find a deferred typebound procedure, check for derived types
- that an over-riding typebound procedure has not been missed. */
- if (e->value.compcall.tbp->deferred
- && e->value.compcall.name
- && !e->value.compcall.tbp->non_overridable
- && e->value.compcall.base_object
- && e->value.compcall.base_object->ts.type == BT_DERIVED)
+ that an overriding typebound procedure has not been missed. */
+ if (e->value.compcall.name
+ && !e->value.compcall.tbp->non_overridable
+ && e->value.compcall.base_object
+ && e->value.compcall.base_object->ts.type == BT_DERIVED)
{
gfc_symtree *st;
gfc_symbol *derived;
--- /dev/null 2012-05-04 18:48:20.115791170 +0200
+++ gcc/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 2012-05-06 18:30:18.000000000 +0200
@@ -0,0 +1,78 @@
+! { dg-do run }
+!
+! PR fortran/53255
+!
+! Contributed by Reinhold Bader.
+!
+! Before TYPE(ext)'s .tr. wronly called the base type's trace
+! instead of ext's trace_ext.
+!
+module mod_base
+ implicit none
+ private
+ integer, public :: base_cnt = 0
+ type, public :: base
+ private
+ real :: r(2,2) = reshape( (/ 1.0, 2.0, 3.0, 4.0 /), (/ 2, 2 /))
+ contains
+ procedure, private :: trace
+ generic :: operator(.tr.) => trace
+ end type base
+contains
+ complex function trace(this)
+ class(base), intent(in) :: this
+ base_cnt = base_cnt + 1
+! write(*,*) 'executing base'
+ trace = this%r(1,1) + this%r(2,2)
+ end function trace
+end module mod_base
+
+module mod_ext
+ use mod_base
+ implicit none
+ private
+ integer, public :: ext_cnt = 0
+ public :: base, base_cnt
+ type, public, extends(base) :: ext
+ private
+ real :: i(2,2) = reshape( (/ 1.0, 1.0, 1.0, 1.5 /), (/ 2, 2 /))
+ contains
+ procedure, private :: trace => trace_ext
+ end type ext
+contains
+ complex function trace_ext(this)
+ class(ext), intent(in) :: this
+
+! the following should be executed through invoking .tr. p below
+! write(*,*) 'executing override'
+ ext_cnt = ext_cnt + 1
+ trace_ext = .tr. this%base + (0.0, 1.0) * ( this%i(1,1) + this%i(2,2) )
+ end function trace_ext
+
+end module mod_ext
+program test_override
+ use mod_ext
+ implicit none
+ type(base) :: o
+ type(ext) :: p
+ real :: r
+
+ ! Note: ext's ".tr." (trace_ext) calls also base's "trace"
+
+! write(*,*) .tr. o
+! write(*,*) .tr. p
+ if (base_cnt /= 0 .or. ext_cnt /= 0) call abort ()
+ r = .tr. o
+ if (base_cnt /= 1 .or. ext_cnt /= 0) call abort ()
+ r = .tr. p
+ if (base_cnt /= 2 .or. ext_cnt /= 1) call abort ()
+
+ if (abs(.tr. o - 5.0 ) < 1.0e-6 .and. abs( .tr. p - (5.0,2.5)) < 1.0e-6) &
+ then
+ if (base_cnt /= 4 .or. ext_cnt /= 2) call abort ()
+! write(*,*) 'OK'
+ else
+ call abort()
+! write(*,*) 'FAIL'
+ end if
+end program test_override
