tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
gfc_add_expr_to_block (&se.pre, tmp);
}
- else if (al->expr->ts.type == BT_CLASS && code->expr3)
+ else if (al->expr->ts.type == BT_CLASS)
{
/* With class objects, it is best to play safe and null the
memory because we cannot know if dynamic types have allocatable
actual->next->expr = gfc_copy_expr (al->expr);
actual->next->expr->ts.type = BT_CLASS;
gfc_add_data_component (actual->next->expr);
+
dataref = actual->next->expr->ref;
+ /* Make sure we go up through the reference chain to
+ the _data reference, where the arrayspec is found. */
+ while (dataref->next && dataref->next->type != REF_ARRAY)
+ dataref = dataref->next;
+
if (dataref->u.c.component->as)
{
int dim;
! { dg-do run }
!
! PR fortran/51972
+! Also tests fixes for PR52102
!
! Check whether DT assignment with polymorphic components works.
!
type(t2) :: one, two
- allocate (two%a(2))
- two%a(1)%x = 4
- two%a(2)%x = 6
+! Test allocate with array source - PR52102
+ allocate (two%a(2), source = [t(4), t(6)])
+
if (allocated (one%a)) call abort ()
+
one = two
if (.not.allocated (one%a)) call abort ()
deallocate (two%a)
one = two
+
+ if (allocated (one%a)) call abort ()
+
+! Test allocate with no source followed by assignments.
+ allocate (two%a(2))
+ two%a(1)%x = 5
+ two%a(2)%x = 7
+
+ if (allocated (one%a)) call abort ()
+
+ one = two
+ if (.not.allocated (one%a)) call abort ()
+
+ if ((one%a(1)%x /= 5)) call abort ()
+ if ((one%a(2)%x /= 7)) call abort ()
+
+ deallocate (two%a)
+ one = two
if (allocated (one%a)) call abort ()
end subroutine test3
if (allocated (one%a)) call abort ()
if (allocated (two%a)) call abort ()
-!
-! FIXME: Fails due to PR 51754
-!
-! NOTE: Might be only visible with MALLOC_PERTURB_ or with valgrind
-!
-! allocate (two%a(2))
-! if (allocated (two%a(1)%x)) call abort ()
-! if (allocated (two%a(2)%x)) call abort ()
-! allocate (two%a(1)%x(3), source=[1,2,3])
-! allocate (two%a(2)%x(5), source=[5,6,7,8,9])
-! one = two
-! if (.not. allocated (one%a)) call abort ()
-! if (.not. allocated (one%a(1)%x)) call abort ()
-! if (.not. allocated (one%a(2)%x)) call abort ()
-!
-! if (size(one%a) /= 2) call abort()
-! if (size(one%a(1)%x) /= 3) call abort()
-! if (size(one%a(2)%x) /= 5) call abort()
-! if (any (one%a(1)%x /= [1,2,3])) call abort ()
-! if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
-!
-! deallocate (two%a(1)%x)
-! one = two
-! if (.not. allocated (one%a)) call abort ()
-! if (allocated (one%a(1)%x)) call abort ()
-! if (.not. allocated (one%a(2)%x)) call abort ()
-!
-! if (size(one%a) /= 2) call abort()
-! if (size(one%a(2)%x) /= 5) call abort()
-! if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
-!
-! deallocate (two%a)
+
+ allocate (two%a(2))
+
+ if (allocated (two%a(1)%x)) call abort ()
+ if (allocated (two%a(2)%x)) call abort ()
+ allocate (two%a(1)%x(3), source=[1,2,3])
+ allocate (two%a(2)%x(5), source=[5,6,7,8,9])
+ one = two
+ if (.not. allocated (one%a)) call abort ()
+ if (.not. allocated (one%a(1)%x)) call abort ()
+ if (.not. allocated (one%a(2)%x)) call abort ()
+
+ if (size(one%a) /= 2) call abort()
+ if (size(one%a(1)%x) /= 3) call abort()
+ if (size(one%a(2)%x) /= 5) call abort()
+ if (any (one%a(1)%x /= [1,2,3])) call abort ()
+ if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
+
+ deallocate (two%a(1)%x)
+ one = two
+ if (.not. allocated (one%a)) call abort ()
+ if (allocated (one%a(1)%x)) call abort ()
+ if (.not. allocated (one%a(2)%x)) call abort ()
+
+ if (size(one%a) /= 2) call abort()
+ if (size(one%a(2)%x) /= 5) call abort()
+ if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
+
+ deallocate (two%a)
one = two
if (allocated (one%a)) call abort ()
if (allocated (two%a)) call abort ()
call test3 ()
call test4 ()
end
+