[Patch, fortran] PR51634 - [OOP] ICE with polymorphic operators

[Patch, fortran] PR51634 - [OOP] ICE with polymorphic operators

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 624 bytes --]

Dear All,

The attached is self-explanatory and fixes the last wrinkles with
PR51634. In addition, the patch incorporates the requirements of class
expressions being used throughout, as reflected in the second
testcase.

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

Cheers

Paul

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

	PR fortran/51634
	* trans-expr.c (gfc_conv_procedure_call): Deallocate allocatable
	components of temporary class arguments.

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

	PR fortran/51634
	* gfortran.dg/typebound_operator_12.f03: New.
	* gfortran.dg/typebound_operator_13.f03: New.

[-- Attachment #2: pr51634.diff --]
[-- Type: text/x-patch, Size: 5707 bytes --]

Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 183125)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 3736,3742 ****
        /* Allocated allocatable components of derived types must be
  	 deallocated for non-variable scalars.  Non-variable arrays are
  	 dealt with in trans-array.c(gfc_conv_array_parameter).  */
!       if (e && e->ts.type == BT_DERIVED
  	    && e->ts.u.derived->attr.alloc_comp
  	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
  	    && (e->expr_type != EXPR_VARIABLE && !e->rank))
--- 3736,3742 ----
        /* Allocated allocatable components of derived types must be
  	 deallocated for non-variable scalars.  Non-variable arrays are
  	 dealt with in trans-array.c(gfc_conv_array_parameter).  */
!       if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS)
  	    && e->ts.u.derived->attr.alloc_comp
  	    && !(e->symtree && e->symtree->n.sym->attr.pointer)
  	    && (e->expr_type != EXPR_VARIABLE && !e->rank))
*************** gfc_conv_procedure_call (gfc_se * se, gf
*** 3768,3773 ****
--- 3768,3783 ----
  	      gfc_add_expr_to_block (&se->post, local_tmp);
  	    }
  
+ 	  if (e->ts.type == BT_DERIVED && fsym && fsym->ts.type == BT_CLASS)
+ 	    {
+ 	      /* The derived type is passed to gfc_deallocate_alloc_comp.
+ 		 Therefore, class actuals can handled correctly but derived
+ 		 types passed to class formals need the _data component.  */
+ 	      tmp = gfc_class_data_get (tmp);
+ 	      if (!CLASS_DATA (fsym)->attr.dimension)
+ 		tmp = build_fold_indirect_ref_loc (input_location, tmp);
+ 	    }
+ 
  	  tmp = gfc_deallocate_alloc_comp (e->ts.u.derived, tmp, parm_rank);
  
  	  gfc_add_expr_to_block (&se->post, tmp);
Index: gcc/testsuite/gfortran.dg/typebound_operator_12.f03
===================================================================
*** gcc/testsuite/gfortran.dg/typebound_operator_12.f03	(revision 0)
--- gcc/testsuite/gfortran.dg/typebound_operator_12.f03	(revision 0)
***************
*** 0 ****
--- 1,45 ----
+ ! { dg-do run }
+ ! PR51634 - Handle allocatable components correctly in expressions 
+ ! involving typebound operators. See comment 2 of PR.
+ !
+ ! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+ ! 
+ module soop_stars_class
+   implicit none
+   type soop_stars
+     real, dimension(:), allocatable :: position,velocity
+   contains
+     procedure :: total
+     procedure :: product
+     generic :: operator(+) => total
+     generic :: operator(*) => product
+   end type
+ contains
+   type(soop_stars) function product(lhs,rhs)
+     class(soop_stars) ,intent(in) :: lhs
+     real ,intent(in) :: rhs
+     product%position = lhs%position*rhs
+     product%velocity = lhs%velocity*rhs
+   end function
+ 
+   type(soop_stars) function total(lhs,rhs)
+     class(soop_stars) ,intent(in) :: lhs,rhs
+     total%position = lhs%position + rhs%position
+     total%velocity = lhs%velocity + rhs%velocity
+   end function
+ end module
+ 
+ program main
+   use soop_stars_class ,only : soop_stars
+   implicit none
+   type(soop_stars) :: fireworks
+   real :: dt
+   fireworks%position = [1,2,3]
+   fireworks%velocity = [4,5,6]
+   dt = 5
+   fireworks = fireworks + fireworks*dt
+   if (any (fireworks%position .ne. [6, 12, 18])) call abort
+   if (any (fireworks%velocity .ne. [24, 30, 36])) call abort
+ end program
+ ! { dg-final { cleanup-modules "soop_stars_class" } }
+ 
Index: gcc/testsuite/gfortran.dg/typebound_operator_13.f03
===================================================================
*** gcc/testsuite/gfortran.dg/typebound_operator_13.f03	(revision 0)
--- gcc/testsuite/gfortran.dg/typebound_operator_13.f03	(revision 0)
***************
*** 0 ****
--- 1,59 ----
+ ! { dg-do run }
+ ! PR51634 - Handle allocatable components correctly in expressions 
+ ! involving typebound operators. From comment 2 of PR but using
+ ! classes throughout.
+ !
+ ! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
+ ! 
+ module soop_stars_class
+   implicit none
+   type soop_stars
+     real, dimension(:), allocatable :: position,velocity
+   contains
+     procedure :: total
+     procedure :: mult
+     procedure :: assign
+     generic :: operator(+) => total
+     generic :: operator(*) => mult
+     generic :: assignment(=) => assign
+   end type
+ contains
+   function mult(lhs,rhs)
+     class(soop_stars) ,intent(in) :: lhs
+     real ,intent(in) :: rhs
+     class(soop_stars), allocatable :: mult
+     type(soop_stars) :: tmp
+     tmp = soop_stars (lhs%position*rhs, lhs%velocity*rhs)
+     allocate (mult, source = tmp)
+   end function
+ 
+   function total(lhs,rhs)
+     class(soop_stars) ,intent(in) :: lhs,rhs
+     class(soop_stars), allocatable :: total
+     type(soop_stars) :: tmp
+     tmp = soop_stars (lhs%position + rhs%position, &
+                       lhs%velocity + rhs%velocity)
+     allocate (total, source = tmp)
+   end function
+ 
+   subroutine assign(lhs,rhs)
+     class(soop_stars), intent(in) :: rhs
+     class(soop_stars), intent(out) :: lhs
+     lhs%position = rhs%position
+     lhs%velocity = rhs%velocity
+   end subroutine
+ end module
+ 
+ program main
+   use soop_stars_class ,only : soop_stars
+   implicit none
+   class(soop_stars), allocatable :: fireworks
+   real :: dt
+   allocate (fireworks, source = soop_stars ([1,2,3], [4,5,6]))
+   dt = 5
+   fireworks = fireworks + fireworks*dt
+   if (any (fireworks%position .ne. [6, 12, 18])) call abort
+   if (any (fireworks%velocity .ne. [24, 30, 36])) call abort
+ end program
+ ! { dg-final { cleanup-modules "soop_stars_class" } }
+ 

Re: [Patch, fortran] PR51634 - [OOP] ICE with polymorphic operators

[Tobias Burnus]

On 01/17/2012 01:25 PM, Paul Richard Thomas wrote:
> The attached is self-explanatory and fixes the last wrinkles with
> PR51634. In addition, the patch incorporates the requirements of class
> expressions being used throughout, as reflected in the second
> testcase.
>
> Bootstrapped and regtested on FC9/x86_64 - OK for trunk.

OK. Thanks for the patch!

Tobias

> 2012-01-17  Paul Thomas<pault@gcc.gnu.org>
>
> 	PR fortran/51634
> 	* trans-expr.c (gfc_conv_procedure_call): Deallocate allocatable
> 	components of temporary class arguments.
>
> 2012-01-17  Paul Thomas<pault@gcc.gnu.org>
>
> 	PR fortran/51634
> 	* gfortran.dg/typebound_operator_12.f03: New.
> 	* gfortran.dg/typebound_operator_13.f03: New.

Re: [Patch, fortran] PR51634 - [OOP] ICE with polymorphic operators

[Paul Richard Thomas]

Dear Tobias,

Committed as r183287.  Thanks for the review.

Paul

>> 2012-01-17  Paul Thomas<pault@gcc.gnu.org>
>>
>>        PR fortran/51634
>>        * trans-expr.c (gfc_conv_procedure_call): Deallocate allocatable
>>        components of temporary class arguments.
>>
>> 2012-01-17  Paul Thomas<pault@gcc.gnu.org>
>>
>>        PR fortran/51634
>>        * gfortran.dg/typebound_operator_12.f03: New.
>>        * gfortran.dg/typebound_operator_13.f03: New.
>
>



-- 
The knack of flying is learning how to throw yourself at the ground and miss.
       --Hitchhikers Guide to the Galaxy