From: pault Date: Sun, 5 Feb 2012 19:56:09 +0000 (+0000) Subject: 2012-02-05 Paul Thomas X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=adb7de2d25b5f0335bce8864d161bd8f6e053ba7;p=thirdparty%2Fgcc.git 2012-02-05 Paul Thomas * trans-array.c (gfc_array_allocate): Zero memory for all class array allocations. * trans-stmt.c (gfc_trans_allocate): Ditto for class scalars. PR fortran/52102 * trans-stmt.c (gfc_trans_allocate): Before correcting a class array reference, ensure that 'dataref' points to the _data component that is followed by the array reference.. 2012-02-05 Paul Thomas PR fortran/52102 * gfortran.dg/class_48.f90 : Add test of allocate class array component with source in subroutine test3. Remove commenting out in subroutine test4, since branching on unitialized variable is now fixed (no PR for this last.). git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183915 138bc75d-0d04-0410-961f-82ee72b054a4 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index db369ab0feb7..e1e81b7f4dcd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2012-02-05 Paul Thomas + + * trans-array.c (gfc_array_allocate): Zero memory for all class + array allocations. + * trans-stmt.c (gfc_trans_allocate): Ditto for class scalars. + + PR fortran/52102 + * trans-stmt.c (gfc_trans_allocate): Before correcting a class + array reference, ensure that 'dataref' points to the _data + component that is followed by the array reference.. + 2012-02-02 Mikael Morin PR fortran/41587 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d3c81a82ab83..edcde5c4c0cb 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -5111,8 +5111,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_add_expr_to_block (&se->pre, tmp); - if (expr->ts.type == BT_CLASS - && (expr3_elem_size != NULL_TREE || expr3)) + if (expr->ts.type == BT_CLASS) { tmp = build_int_cst (unsigned_char_type_node, 0); /* With class objects, it is best to play safe and null the diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 7a6f8b2b419a..7d094b0311ee 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4957,7 +4957,7 @@ gfc_trans_allocate (gfc_code * code) 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 @@ -5076,7 +5076,13 @@ gfc_trans_allocate (gfc_code * code) 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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 50143e4d6fd3..4c9c499c6053 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2012-02-05 Paul Thomas + + PR fortran/52102 + * gfortran.dg/class_48.f90 : Add test of allocate class array + component with source in subroutine test3. Remove commenting + out in subroutine test4, since branching on unitialized variable + is now fixed (no PR for this last.). + 2012-02-05 Richard Sandiford * gcc.dg/tree-prof/stringop-2.c (main): Add a nomips16 attribute diff --git a/gcc/testsuite/gfortran.dg/class_48.f90 b/gcc/testsuite/gfortran.dg/class_48.f90 index c1bab8ef0d59..37ee8626c351 100644 --- a/gcc/testsuite/gfortran.dg/class_48.f90 +++ b/gcc/testsuite/gfortran.dg/class_48.f90 @@ -1,6 +1,7 @@ ! { dg-do run } ! ! PR fortran/51972 +! Also tests fixes for PR52102 ! ! Check whether DT assignment with polymorphic components works. ! @@ -70,16 +71,35 @@ subroutine test3 () 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 () if ((one%a(1)%x /= 4)) call abort () if ((one%a(2)%x /= 6)) 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 () @@ -98,38 +118,35 @@ subroutine test4 () 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 () @@ -141,3 +158,4 @@ call test2 () call test3 () call test4 () end +