+2011-08-29 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50225
+ * trans-decl.c (gfc_generate_function_code): Nullify polymorphic
+ allocatable function results.
+
2011-08-29 Tobias Burnus <burnus@net-b.de>
* trans-decl.c (generate_coarray_sym_init): Use
{
tree result = get_proc_result (sym);
- if (result != NULL_TREE
- && sym->attr.function
- && !sym->attr.pointer)
+ if (result != NULL_TREE && sym->attr.function && !sym->attr.pointer)
{
if (sym->attr.allocatable && sym->attr.dimension == 0
&& sym->result == sym)
gfc_add_modify (&init, result, fold_convert (TREE_TYPE (result),
null_pointer_node));
+ else if (sym->ts.type == BT_CLASS
+ && CLASS_DATA (sym)->attr.allocatable
+ && sym->attr.dimension == 0 && sym->result == sym)
+ {
+ tmp = CLASS_DATA (sym)->backend_decl;
+ tmp = fold_build3_loc (input_location, COMPONENT_REF,
+ TREE_TYPE (tmp), result, tmp, NULL_TREE);
+ gfc_add_modify (&init, tmp, fold_convert (TREE_TYPE (tmp),
+ null_pointer_node));
+ }
else if (sym->ts.type == BT_DERIVED
- && sym->ts.u.derived->attr.alloc_comp
- && !sym->attr.allocatable)
+ && sym->ts.u.derived->attr.alloc_comp
+ && !sym->attr.allocatable)
{
rank = sym->as ? sym->as->rank : 0;
tmp = gfc_nullify_alloc_comp (sym->ts.u.derived, result, rank);
+2011-08-29 Janus Weil <janus@gcc.gnu.org>
+
+ PR fortran/50225
+ * gfortran.dg/class_result_1.f03: New.
+
2011-08-29 Jakub Jelinek <jakub@redhat.com>
PR middle-end/48722
--- /dev/null
+! { dg-do run }
+! { dg-options "-fcheck=all" }
+!
+! PR 50225: [OOP] The allocation status for polymorphic allocatable function results is not set properly
+!
+! Contributed by Arjen Markus <arjen.markus895@gmail.com>
+
+module points2d
+
+ implicit none
+
+ type point2d
+ real :: x, y
+ end type
+
+contains
+
+ subroutine print( point )
+ class(point2d) :: point
+ write(*,'(2f10.4)') point%x, point%y
+ end subroutine
+
+ subroutine random_vector( point )
+ class(point2d) :: point
+ call random_number( point%x )
+ call random_number( point%y )
+ point%x = 2.0 * (point%x - 0.5)
+ point%y = 2.0 * (point%y - 0.5)
+ end subroutine
+
+ function add_vector( point, vector )
+ class(point2d), intent(in) :: point, vector
+ class(point2d), allocatable :: add_vector
+ allocate( add_vector )
+ add_vector%x = point%x + vector%x
+ add_vector%y = point%y + vector%y
+ end function
+
+end module points2d
+
+
+program random_walk
+
+ use points2d
+ implicit none
+
+ type(point2d), target :: point_2d, vector_2d
+ class(point2d), pointer :: point, vector
+ integer :: i
+
+ point => point_2d
+ vector => vector_2d
+
+ do i=1,2
+ call random_vector(point)
+ call random_vector(vector)
+ call print(add_vector(point, vector))
+ end do
+
+end program random_walk
+
+! { dg-final { cleanup-modules "points2d" } }