fortran ChangeLog:
2005-11-19 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/24862 * trans-io.c (gfc_trans_transfer): Handle arrays of derived type. testsuite ChangeLog: 2005-11-19 Janne Blomqvist <jb@gcc.gnu.org> PR fortran/24862 * gfortran.dg/arrayio_derived_1.f90: New test. From-SVN: r107228
This commit is contained in:
parent
3817707ec3
commit
815d8045e0
|
@ -1,3 +1,8 @@
|
||||||
|
2005-11-19 Janne Blomqvist <jb@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/24862
|
||||||
|
* trans-io.c (gfc_trans_transfer): Handle arrays of derived type.
|
||||||
|
|
||||||
2005-11-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
2005-11-17 Francois-Xavier Coudert <coudert@clipper.ens.fr>
|
||||||
|
|
||||||
PR fortran/20811
|
PR fortran/20811
|
||||||
|
|
|
@ -1640,11 +1640,41 @@ gfc_trans_transfer (gfc_code * code)
|
||||||
|
|
||||||
if (ss == gfc_ss_terminator)
|
if (ss == gfc_ss_terminator)
|
||||||
{
|
{
|
||||||
|
/* Transfer a scalar value. */
|
||||||
gfc_conv_expr_reference (&se, expr);
|
gfc_conv_expr_reference (&se, expr);
|
||||||
transfer_expr (&se, &expr->ts, 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. */
|
/* Initialize the scalarizer. */
|
||||||
gfc_init_loopinfo (&loop);
|
gfc_init_loopinfo (&loop);
|
||||||
gfc_add_ss_to_loop (&loop, ss);
|
gfc_add_ss_to_loop (&loop, ss);
|
||||||
|
@ -1663,13 +1693,8 @@ gfc_trans_transfer (gfc_code * code)
|
||||||
gfc_conv_expr_reference (&se, expr);
|
gfc_conv_expr_reference (&se, expr);
|
||||||
transfer_expr (&se, &expr->ts, se.expr);
|
transfer_expr (&se, &expr->ts, se.expr);
|
||||||
}
|
}
|
||||||
else
|
|
||||||
{
|
finish_block_label:
|
||||||
/* 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);
|
|
||||||
}
|
|
||||||
|
|
||||||
gfc_add_block_to_block (&body, &se.pre);
|
gfc_add_block_to_block (&body, &se.pre);
|
||||||
gfc_add_block_to_block (&body, &se.post);
|
gfc_add_block_to_block (&body, &se.post);
|
||||||
|
|
|
@ -1,3 +1,8 @@
|
||||||
|
2005-11-19 Janne Blomqvist <jb@gcc.gnu.org>
|
||||||
|
|
||||||
|
PR fortran/24862
|
||||||
|
* gfortran.dg/arrayio_derived_1.f90: New test.
|
||||||
|
|
||||||
2005-11-19 Richard Guenther <rguenther@suse.de>
|
2005-11-19 Richard Guenther <rguenther@suse.de>
|
||||||
|
|
||||||
PR middle-end/23294
|
PR middle-end/23294
|
||||||
|
|
|
@ -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
|
Loading…
Reference in New Issue