This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Patch, fortran] PR30284 and PR30626 - ICEs with internal units
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: Fortran List <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Thu, 01 Feb 2007 23:43:55 +0100
- Subject: [Patch, fortran] PR30284 and PR30626 - ICEs with internal units
:ADDPATCH fortran:
These two PRs are effectively identical and are fixed by the same patch.
The problem is that substring or components references of arrays result
in element sizes that are smaller than the stride in bytes. This is
fixed by using the same temporary builder that fixed a similar problem
in gfc_conv_function_call. A temporary is created that is copied to and
used as the internal unit for READ or is used and copied back from for
WRITE. The testcases are the reporter's.
Note that I am perfectly prepared to change the names of
gfc_conv_aliased_arg and is_aliased_array, if only somebody would tell
me what they should be called :-)
Bootrtrapped and regtested on amd64/Cygwin_NT - OK for trunk and a week
or two later for 4.2?
Paul
2007-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30284
PR fortran/30626
* trans-expr.c (gfc_conv_aliased_arg): Remove static attribute
from function and make sure that substring lengths are
translated.
(is_aliased_array): Remove static attribute.
* trans.c : Add prototypes for gfc_conv_aliased_arg and
is_aliased_array.
* trans-io.c (set_internal_unit): Add the post block to the
arguments of the function. Use is_aliased_array to check if
temporary is needed; if so call gfc_conv_aliased_arg.
(build_dt): Pass the post block to set_internal_unit and
add to the block after all io activiy is done.
2007-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30284
PR fortran/30626
* io/transfer.c (init_loop_spec, next_array_record): Change to
lbound rather than unity base.
2007-02-02 Paul Thomas <pault@gcc.gnu.org>
PR fortran/30284
* gfortran.dg/arrayio_11.f90.f90: New test.
PR fortran/30626
* gfortran.dg/arrayio_12.f90.f90: New test.
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c (revision 121280)
--- gcc/fortran/trans-expr.c (working copy)
*************** gfc_apply_interface_mapping (gfc_interfa
*** 1682,1690 ****
an actual argument derived type array is copied and then returned
after the function call.
TODO Get rid of this kludge, when array descriptors are capable of
! handling aliased arrays. */
! static void
gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
int g77, sym_intent intent)
{
--- 1682,1690 ----
an actual argument derived type array is copied and then returned
after the function call.
TODO Get rid of this kludge, when array descriptors are capable of
! handling arrays with a bigger stride in bytes than size. */
! void
gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
int g77, sym_intent intent)
{
*************** gfc_conv_aliased_arg (gfc_se * parmse, g
*** 1733,1739 ****
{
gfc_ref *char_ref = expr->ref;
! for (; expr->ts.cl == NULL && char_ref; char_ref = char_ref->next)
if (char_ref->type == REF_SUBSTRING)
{
gfc_se tmp_se;
--- 1733,1739 ----
{
gfc_ref *char_ref = expr->ref;
! for (; char_ref; char_ref = char_ref->next)
if (char_ref->type == REF_SUBSTRING)
{
gfc_se tmp_se;
*************** gfc_conv_aliased_arg (gfc_se * parmse, g
*** 1928,1934 ****
/* Is true if an array reference is followed by a component or substring
reference. */
! static bool
is_aliased_array (gfc_expr * e)
{
gfc_ref * ref;
--- 1928,1934 ----
/* Is true if an array reference is followed by a component or substring
reference. */
! bool
is_aliased_array (gfc_expr * e)
{
gfc_ref * ref;
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (revision 121280)
--- gcc/fortran/trans.h (working copy)
*************** tree gfc_conv_operator_assign (gfc_se *,
*** 309,314 ****
--- 309,318 ----
/* Also used to CALL subroutines. */
int gfc_conv_function_call (gfc_se *, gfc_symbol *, gfc_actual_arglist *,
tree);
+
+ void gfc_conv_aliased_arg (gfc_se *, gfc_expr *, int, sym_intent);
+ bool is_aliased_array (gfc_expr *);
+
/* gfc_trans_* shouldn't call push/poplevel, use gfc_push/pop_scope */
/* Generate code for a scalar assignment. */
Index: gcc/fortran/trans-io.c
===================================================================
*** gcc/fortran/trans-io.c (revision 121280)
--- gcc/fortran/trans-io.c (working copy)
*************** set_string (stmtblock_t * block, stmtblo
*** 586,592 ****
for an internal unit. */
static unsigned int
! set_internal_unit (stmtblock_t * block, tree var, gfc_expr * e)
{
gfc_se se;
tree io;
--- 586,593 ----
for an internal unit. */
static unsigned int
! set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
! tree var, gfc_expr * e)
{
gfc_se se;
tree io;
*************** set_internal_unit (stmtblock_t * block,
*** 624,633 ****
{
se.ss = gfc_walk_expr (e);
! /* Return the data pointer and rank from the descriptor. */
! gfc_conv_expr_descriptor (&se, e, se.ss);
! tmp = gfc_conv_descriptor_data_get (se.expr);
! se.expr = gfc_build_addr_expr (pchar_type_node, se.expr);
}
else
gcc_unreachable ();
--- 625,647 ----
{
se.ss = gfc_walk_expr (e);
! if (is_aliased_array (e))
! {
! /* Use a temporary for components of arrays of derived types
! or substring array references. */
! gfc_conv_aliased_arg (&se, e, 0,
! last_dt == READ ? INTENT_IN : INTENT_OUT);
! tmp = build_fold_indirect_ref (se.expr);
! se.expr = gfc_build_addr_expr (pchar_type_node, tmp);
! tmp = gfc_conv_descriptor_data_get (tmp);
! }
! else
! {
! /* Return the data pointer and rank from the descriptor. */
! gfc_conv_expr_descriptor (&se, e, se.ss);
! tmp = gfc_conv_descriptor_data_get (se.expr);
! se.expr = gfc_build_addr_expr (pchar_type_node, se.expr);
! }
}
else
gcc_unreachable ();
*************** set_internal_unit (stmtblock_t * block,
*** 635,644 ****
/* The cast is needed for character substrings and the descriptor
data. */
gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), tmp));
! gfc_add_modify_expr (&se.pre, len, se.string_length);
gfc_add_modify_expr (&se.pre, desc, se.expr);
gfc_add_block_to_block (block, &se.pre);
return mask;
}
--- 649,660 ----
/* The cast is needed for character substrings and the descriptor
data. */
gfc_add_modify_expr (&se.pre, io, fold_convert (TREE_TYPE (io), tmp));
! gfc_add_modify_expr (&se.pre, len,
! fold_convert (TREE_TYPE (len), se.string_length));
gfc_add_modify_expr (&se.pre, desc, se.expr);
gfc_add_block_to_block (block, &se.pre);
+ gfc_add_block_to_block (post_block, &se.post);
return mask;
}
*************** transfer_namelist_element (stmtblock_t *
*** 1371,1377 ****
static tree
build_dt (tree function, gfc_code * code)
{
! stmtblock_t block, post_block, post_end_block;
gfc_dt *dt;
tree tmp, var;
gfc_expr *nmlname;
--- 1387,1393 ----
static tree
build_dt (tree function, gfc_code * code)
{
! stmtblock_t block, post_block, post_end_block, post_iu_block;
gfc_dt *dt;
tree tmp, var;
gfc_expr *nmlname;
*************** build_dt (tree function, gfc_code * code
*** 1381,1386 ****
--- 1397,1403 ----
gfc_start_block (&block);
gfc_init_block (&post_block);
gfc_init_block (&post_end_block);
+ gfc_init_block (&post_iu_block);
var = gfc_create_var (st_parameter[IOPARM_ptype_dt].type, "dt_parm");
*************** build_dt (tree function, gfc_code * code
*** 1411,1417 ****
{
if (dt->io_unit->ts.type == BT_CHARACTER)
{
! mask |= set_internal_unit (&block, var, dt->io_unit);
set_parameter_const (&block, var, IOPARM_common_unit, 0);
}
else
--- 1428,1435 ----
{
if (dt->io_unit->ts.type == BT_CHARACTER)
{
! mask |= set_internal_unit (&block, &post_iu_block,
! var, dt->io_unit);
set_parameter_const (&block, var, IOPARM_common_unit, 0);
}
else
*************** build_dt (tree function, gfc_code * code
*** 1502,1507 ****
--- 1520,1527 ----
gfc_add_expr_to_block (&block, gfc_trans_code (code->block->next));
+ gfc_add_block_to_block (&block, &post_iu_block);
+
dt_parm = NULL;
dt_post_end_block = NULL;
Index: libgfortran/io/transfer.c
===================================================================
*** libgfortran/io/transfer.c (revision 121280)
--- libgfortran/io/transfer.c (working copy)
*************** init_loop_spec (gfc_array_char *desc, ar
*** 2013,2019 ****
index = 1;
for (i=0; i<rank; i++)
{
! ls[i].idx = 1;
ls[i].start = desc->dim[i].lbound;
ls[i].end = desc->dim[i].ubound;
ls[i].step = desc->dim[i].stride;
--- 2013,2019 ----
index = 1;
for (i=0; i<rank; i++)
{
! ls[i].idx = desc->dim[i].lbound;
ls[i].start = desc->dim[i].lbound;
ls[i].end = desc->dim[i].ubound;
ls[i].step = desc->dim[i].stride;
*************** next_array_record (st_parameter_dt *dtp,
*** 2050,2057 ****
else
carry = 0;
}
! index = index + (ls[i].idx - 1) * ls[i].step;
}
return index;
}
--- 2050,2058 ----
else
carry = 0;
}
! index = index + (ls[i].idx - ls[i].start) * ls[i].step;
}
+
return index;
}
Index: gcc/testsuite/gfortran.dg/arrayio_11.f90
===================================================================
*** gcc/testsuite/gfortran.dg/arrayio_11.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/arrayio_11.f90 (revision 0)
***************
*** 0 ****
--- 1,45 ----
+ ! { dg-do run }
+ ! Tests the fix for PR30284, in which the substring plus
+ ! component reference for an internal file would cause an ICE.
+ !
+ ! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+ program gfcbug51
+ implicit none
+
+ type :: date_t
+ character(len=12) :: date ! yyyymmddhhmm
+ end type date_t
+
+ type year_t
+ integer :: year = 0
+ end type year_t
+
+ type(date_t) :: file(3)
+ type(year_t) :: time(3)
+
+ FILE%date = (/'200612231200', '200712231200', &
+ '200812231200'/)
+
+ time = date_to_year (FILE)
+ if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
+
+ call month_to_date ((/8, 9, 10/), FILE)
+ if ( any (file%date .ne. (/'200608231200', '200709231200', &
+ '200810231200'/))) call abort ()
+
+ contains
+
+ function date_to_year (d) result (y)
+ type(date_t) :: d(3)
+ type(year_t) :: y(size (d, 1))
+ read (d%date(1:4),'(i4)') time% year
+ end function date_to_year
+
+ subroutine month_to_date (m, d)
+ type(date_t) :: d(3)
+ integer :: m(:)
+ write (d%date(5:6),'(i2.2)') m
+ end subroutine month_to_date
+
+ end program gfcbug51
Index: gcc/testsuite/gfortran.dg/arrayio_12.f90
===================================================================
*** gcc/testsuite/gfortran.dg/arrayio_12.f90 (revision 0)
--- gcc/testsuite/gfortran.dg/arrayio_12.f90 (revision 0)
***************
*** 0 ****
--- 1,42 ----
+ ! { dg-do run }
+ ! Tests the fix for PR30626, in which the substring reference
+ ! for an internal file would cause an ICE.
+ !
+ ! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+
+ program gfcbug51
+ implicit none
+
+ character(len=12) :: cdate(3) ! yyyymmddhhmm
+
+ type year_t
+ integer :: year = 0
+ end type year_t
+
+ type(year_t) :: time(3)
+
+ cdate = (/'200612231200', '200712231200', &
+ '200812231200'/)
+
+ time = date_to_year (cdate)
+ if (any (time%year .ne. (/2006, 2007, 2008/))) call abort ()
+
+ call month_to_date ((/8, 9, 10/), cdate)
+ if ( any (cdate .ne. (/'200608231200', '200709231200', &
+ '200810231200'/))) call abort ()
+
+ contains
+
+ function date_to_year (d) result (y)
+ character(len=12) :: d(3)
+ type(year_t) :: y(size (d, 1))
+ read (cdate(:)(1:4),'(i4)') time% year
+ end function date_to_year
+
+ subroutine month_to_date (m, d)
+ character(len=12) :: d(3)
+ integer :: m(:)
+ write (cdate(:)(5:6),'(i2.2)') m
+ end subroutine month_to_date
+
+ end program gfcbug51