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

        Backport from mainline:
        2012-05-07  Tobias Burnus  <burnus@net-b.de>

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

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

        Backport from mainline:
        2012-05-07  Tobias Burnus  <burnus@net-b.de>

        PR fortran/53255
        * gfortran.dg/typebound_operator_15.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@187232 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e853b68..f061f46 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,12 @@
+2012-05-07  Tobias Burnus  <burnus@net-b.de>
+
+       Backport from mainline:
+       2012-05-07  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/53255
+       * resolve.c (resolve_typebound_static): Fix handling
+       of overridden specific to generic operator.
+
 2012-05-05  Tobias Burnus  <burnus@net-b.de>
 
        Backport from mainline:

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 814416c..9f34ce0 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5624,12 +5624,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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d052ada..1a9bf6d 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2012-05-07  Tobias Burnus  <burnus@net-b.de>
+
+       Backport from mainline:
+       2012-05-07  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/53255
+       * gfortran.dg/typebound_operator_15.f90: New.
+
 2012-05-05  Tobias Burnus  <burnus@net-b.de>
 
        Backport from mainline:

diff --git a/gcc/testsuite/gfortran.dg/typebound_operator_15.f90 b/gcc/testsuite/gfortran.dg/typebound_operator_15.f90
new file mode 100644 (file)
index 0000000..ca4d45c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/typebound_operator_15.f90
@@ -0,0 +1,78 @@
+! { dg-do run }
+!
+! PR fortran/53255
+!
+! Contributed by Reinhold Bader.
+!
+! Before TYPE(ext)'s .tr. wrongly 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