Patchwork [Fortran] PR53255 - fix type-bound operator handling

login
register
mail settings
Submitter Tobias Burnus
Date May 6, 2012, 5:05 p.m.
Message ID <4FA6AF5C.5020704@net-b.de>
Download mbox | patch
Permalink /patch/157113/
State New
Headers show

Comments

Tobias Burnus - May 6, 2012, 5:05 p.m.
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
Paul Richard Thomas - May 7, 2012, 8:08 a.m.
Hi Tobias,

Nice call!  Apart from s/wronly/wrongly/ in the testcase, this is
certainly OK for trunk and, I would suggest, as far back as you have
the intestinal fortitude to go. I suspect, without checking, that the
patch might not do the right thing on 4.5.

Thanks for the patch for what you carrectly describe as a nasty wrong code bug.

Cheers

Paul

On 6 May 2012 19:05, Tobias Burnus <burnus@net-b.de> wrote:
> 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
Janus Weil - May 7, 2012, 8:41 a.m.
Hi,

> Nice call!  Apart from s/wronly/wrongly/ in the testcase, this is
> certainly OK for trunk and, I would suggest, as far back as you have
> the intestinal fortitude to go. I suspect, without checking, that the
> patch might not do the right thing on 4.5.

agreed. Apart from the fact that the patch might not even be
applicable for 4.5, which I'm sure of (without checking), the 4.5
release was never recommended for serious OOP applications, and many
thing just don't work there (since it was our first experimental OOP
release). Therefore I think it's not worth going further back than
4.6.

Thanks for the patch,
Janus



> On 6 May 2012 19:05, Tobias Burnus <burnus@net-b.de> wrote:
>> 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
>
>
>
> --
> The knack of flying is learning how to throw yourself at the ground and miss.
>        --Hitchhikers Guide to the Galaxy

Patch

2012-05-06  Tobias Burnus  <burnus@net-b.de>

	PR fortran/53255
	* resolve.c (resolve_typebound_static): Fix handling
	of overridden specific to generic operator.

2012-05-06  Tobias Burnus  <burnus@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