diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6ed025bddd8..783e3fb1013 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2005-11-19 Janne Blomqvist + + PR fortran/24862 + * trans-io.c (gfc_trans_transfer): Handle arrays of derived type. + 2005-11-17 Francois-Xavier Coudert PR fortran/20811 diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 5eed8e83ece..bdfa450dc2a 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -1640,11 +1640,41 @@ gfc_trans_transfer (gfc_code * code) if (ss == gfc_ss_terminator) { + /* Transfer a scalar value. */ gfc_conv_expr_reference (&se, expr); transfer_expr (&se, &expr->ts, se.expr); } - else if (expr->ts.type == BT_DERIVED) + else { + /* Transfer an array. There are 3 options: + 1) An array of an intrinsic type. This is handled by transfering + the descriptor to the library. + 2) A derived type containing an array. Scalarized by the frontend. + 3) An array of derived type. Scalarized by the frontend. + */ + if (expr->ts.type != BT_DERIVED) + { + /* Get the descriptor. */ + gfc_conv_expr_descriptor (&se, expr, ss); + /* If it's not an array of derived type, transfer the array + descriptor to the library. */ + tmp = gfc_get_dtype (TREE_TYPE (se.expr)); + if (((TREE_INT_CST_LOW (tmp) & GFC_DTYPE_TYPE_MASK) + >> GFC_DTYPE_TYPE_SHIFT) != GFC_DTYPE_DERIVED) + { + tmp = gfc_build_addr_expr (NULL, se.expr); + transfer_array_desc (&se, &expr->ts, tmp); + goto finish_block_label; + } + else + { + /* Cleanup the mess getting the descriptor caused. */ + expr = code->expr; + ss = gfc_walk_expr (expr); + gfc_init_se (&se, NULL); + } + } + /* Initialize the scalarizer. */ gfc_init_loopinfo (&loop); gfc_add_ss_to_loop (&loop, ss); @@ -1663,13 +1693,8 @@ gfc_trans_transfer (gfc_code * code) gfc_conv_expr_reference (&se, expr); transfer_expr (&se, &expr->ts, se.expr); } - else - { - /* Pass the array descriptor to the library. */ - gfc_conv_expr_descriptor (&se, expr, ss); - tmp = gfc_build_addr_expr (NULL, se.expr); - transfer_array_desc (&se, &expr->ts, tmp); - } + + finish_block_label: gfc_add_block_to_block (&body, &se.pre); gfc_add_block_to_block (&body, &se.post); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3c79b1e854f..62e03098018 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2005-11-19 Janne Blomqvist + + PR fortran/24862 + * gfortran.dg/arrayio_derived_1.f90: New test. + 2005-11-19 Richard Guenther PR middle-end/23294 diff --git a/gcc/testsuite/gfortran.dg/arrayio_derived_1.f90 b/gcc/testsuite/gfortran.dg/arrayio_derived_1.f90 new file mode 100644 index 00000000000..d0d3aa256a0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/arrayio_derived_1.f90 @@ -0,0 +1,33 @@ +! { dg-do run } +! PR 24862: IO for arrays of derived type handled incorrectly. +program arrayio_derived_1 + implicit none + type tp + integer :: i + character(len=1) :: c + end type tp + type(tp) :: x(5) + character(len=100) :: a + integer :: i, b(5) + + x%i = 256 + x%c = "q" + + write(a, *) x%i + read(a, *) b + do i = 1, 5 + if (b(i) /= 256) then + call abort () + end if + end do + write(a, *) x ! Just test that the library doesn't abort. + write(a, *) x(:)%i + b = 0 + read(a, *) b + do i = 1, 5 + if (b(i) /= 256) then + call abort () + end if + end do + +end program arrayio_derived_1