diff mbox

[fortran] PR48946 - Deferred Overloaded Assignment

Message ID CAGkQGiJ4e9oorucfFMweWakZX5jko1txW68=TPJ2yCH=LDBigA@mail.gmail.com
State New
Headers show

Commit Message

Paul Richard Thomas Jan. 3, 2012, 8:30 p.m. UTC 
Dear All,

This is a straightforward patch that adds a last ditch attempt to find
a specific typebound procedure when all that has been found for a
derived type base object is 'deferred'.  typebound_operator_7.f03 has
been extended to test derived type as well as class base objects.

Bootstrapped and regtested on x86_64/FC9 - OK for trunk?

Paul

2012-01-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/PR48946
	* resolve.c (resolve_typebound_static): If the typebound
	procedure is 'deferred' have a go at finding the right specific
	procedure in the derived type operator space itself.

2012-01-03  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/PR48946
	* gfortran.dg/typebound_operator_7.f03: Add test for derived
	type typebound operators as well as class bound operators.

Comments

Thomas Koenig Jan. 4, 2012, 8:12 a.m. UTC | #1 
Hi Paul,

> Dear All,
>
> This is a straightforward patch that adds a last ditch attempt to find
> a specific typebound procedure when all that has been found for a
> derived type base object is 'deferred'.  typebound_operator_7.f03 has
> been extended to test derived type as well as class base objects.
>
> Bootstrapped and regtested on x86_64/FC9 - OK for trunk?

I am not really familiar with the OOP stuff, but this looks OK for me.
Just one nit:


> 2012-01-03  Paul Thomas<pault@gcc.gnu.org>
>
> 	PR fortran/PR48946
> 	* gfortran.dg/typebound_operator_7.f03: Add test for derived
> 	type typebound operators as well as class bound operators.

Wouldn't it be better to make a new test case?  If there turns out
to be a regression later, changing test cases makes it harder to
find.

You could just commit the test case 'as is' as typebound_operator_8.f03
and leave the old one.

Regards

	Thomas
Paul Richard Thomas Jan. 4, 2012, 8:25 a.m. UTC | #2 
Dear Thomas,

Happy New Year!


> Wouldn't it be better to make a new test case?  If there turns out
> to be a regression later, changing test cases makes it harder to
> find.
>
> You could just commit the test case 'as is' as typebound_operator_8.f03
> and leave the old one.
>
> Regards
>
>        Thomas
>
I am happy enough to do that.  *_8.f03 already exists.... :-)

Cheers

Paul
diff mbox

Patch

Index: gcc/fortran/resolve.c
===================================================================
*** gcc/fortran/resolve.c	(revision 182853)
--- gcc/fortran/resolve.c	(working copy)
*************** resolve_typebound_static (gfc_expr* e, g
*** 5614,5619 ****
--- 5614,5646 ----
    e->ref = NULL;
    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)
+    {
+      gfc_symtree *st;
+      gfc_symbol *derived;
+ 
+      /* Use the derived type of the base_object.  */
+      derived = e->value.compcall.base_object->ts.u.derived;
+      st = NULL;
+ 
+      /* Look for the typebound procedure 'name'.  */
+      if (derived->f2k_derived && derived->f2k_derived->tb_sym_root)
+ 	st = gfc_find_symtree (derived->f2k_derived->tb_sym_root,
+ 			       e->value.compcall.name);
+ 
+      /* Now find the specific name in the derived type namespace.  */
+      if (st && st->n.tb && st->n.tb->u.specific)
+ 	gfc_find_sym_tree (st->n.tb->u.specific->name,
+ 			   derived->ns, 1, &st);
+      if (st)
+ 	*target = st;
+    }
    return SUCCESS;
  }
  
Index: gcc/testsuite/gfortran.dg/typebound_operator_7.f03
===================================================================
*** gcc/testsuite/gfortran.dg/typebound_operator_7.f03	(revision 182853)
--- gcc/testsuite/gfortran.dg/typebound_operator_7.f03	(working copy)
***************
*** 1,5 ****
--- 1,6 ----
  ! { dg-do run }
  ! PR46328 - complex expressions involving typebound operators of class objects.
+ ! PR48946 - complex expressions involving typebound operators of derived types.
  !
  module field_module
    implicit none
*************** end module
*** 87,103 ****
  program main
    use i_field_module
    implicit none
!   class(i_field) ,allocatable :: u
!   allocate (u, source = i_field (99))
! 
!   u = u*2.
!   u = (u*2.0*4.0) + u*4.0
!   u = u%multiply_real (2.0)*4.0
!   u = i_multiply_real (u, 2.0) * 4.0
!   
!   select type (u)
!     type is (i_field); if (u%i .ne. 152064) call abort
!   end select
  end program
  ! { dg-final { cleanup-modules "field_module i_field_module" } }
  
--- 88,118 ----
  program main
    use i_field_module
    implicit none
!   call check_class_tbos
!   call check_derived_type_tbos
! contains
!   subroutine check_class_tbos
!     class(i_field) ,allocatable :: u
!     allocate (u, source = i_field (99))
!     u = u*2.
!     u = (u*2.0*4.0) + u*4.0
!     u = u%multiply_real (2.0)*4.0
!     u = i_multiply_real (u, 2.0) * 4.0
!     select type (u)
!       type is (i_field); if (u%i .ne. 152064) call abort
!     end select
!     deallocate (u)
!   end subroutine
!   subroutine check_derived_type_tbos
!     type(i_field) ,allocatable :: u
!     allocate (u, source = i_field (99))
!     u = u*2.
!     u = (u*2.0*4.0) + u*4.0
!     u = u%multiply_real (2.0)*4.0
!     u = i_multiply_real (u, 2.0) * 4.0
!     if (u%i .ne. 152064) call abort
!     deallocate (u)
!   end subroutine
  end program
  ! { dg-final { cleanup-modules "field_module i_field_module" } }