+2012-01-18 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 Tobias Burnus <burnus@net-b.de>
Janne Blomqvist <jb@gcc.gnu.org>
/* 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
+ 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_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);
+2012-01-18 Paul Thomas <pault@gcc.gnu.org>
+
+ PR fortran/51634
+ * gfortran.dg/typebound_operator_12.f03: New.
+ * gfortran.dg/typebound_operator_13.f03: New.
+
2012-01-18 Paolo Carlini <paolo.carlini@oracle.com>
PR c++/51225
--- /dev/null
+! { 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" } }
+
--- /dev/null
+! { 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" } }
+