procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/30284 ([4.1 only] ICE in gfc_add_modify with internal reads)

Browse source 
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.

From-SVN: r121500
This commit is contained in:
Paul Thomas 2007-02-02 12:35:57 +00:00
parent 47742ccdde
commit d4feb3d31a
9 changed files with 157 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
gcc/fortran/ChangeLog
View file

@ -1,3 +1,19 @@
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-01 Roger Sayle <roger@eyesopen.com>
* trans-array.c (gfc_conv_expr_descriptor): We don't need to use

8
gcc/fortran/trans-expr.c
View file

@ -1682,9 +1682,9 @@ gfc_apply_interface_mapping (gfc_interface_mapping * mapping,
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. */
handling arrays with a bigger stride in bytes than size. */
static void
void
gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
int g77, sym_intent intent)
{
@ -1733,7 +1733,7 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
{
gfc_ref *char_ref = expr->ref;
for (; expr->ts.cl == NULL && char_ref; char_ref = char_ref->next)
for (; char_ref; char_ref = char_ref->next)
if (char_ref->type == REF_SUBSTRING)
{
gfc_se tmp_se;
@ -1928,7 +1928,7 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
/* Is true if an array reference is followed by a component or substring
reference. */
static bool
bool
is_aliased_array (gfc_expr * e)
{
gfc_ref * ref;

36
gcc/fortran/trans-io.c
View file

@ -586,7 +586,8 @@ set_string (stmtblock_t * block, stmtblock_t * postblock, tree var,
for an internal unit. */
static unsigned int
set_internal_unit (stmtblock_t * block, tree var, gfc_expr * e)
set_internal_unit (stmtblock_t * block, stmtblock_t * post_block,
tree var, gfc_expr * e)
{
gfc_se se;
tree io;
@ -624,10 +625,23 @@ set_internal_unit (stmtblock_t * block, tree var, gfc_expr * e)
{
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);
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 ();
@ -635,10 +649,12 @@ set_internal_unit (stmtblock_t * block, tree var, gfc_expr * e)
/* 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, 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;
}
@ -1371,7 +1387,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
static tree
build_dt (tree function, gfc_code * code)
{
stmtblock_t block, post_block, post_end_block;
stmtblock_t block, post_block, post_end_block, post_iu_block;
gfc_dt *dt;
tree tmp, var;
gfc_expr *nmlname;
@ -1381,6 +1397,7 @@ build_dt (tree function, gfc_code * code)
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");
@ -1411,7 +1428,8 @@ build_dt (tree function, gfc_code * code)
{
if (dt->io_unit->ts.type == BT_CHARACTER)
{
mask |= set_internal_unit (&block, var, dt->io_unit);
mask |= set_internal_unit (&block, &post_iu_block,
var, dt->io_unit);
set_parameter_const (&block, var, IOPARM_common_unit, 0);
}
else
@ -1502,6 +1520,8 @@ build_dt (tree function, gfc_code * code)
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;

4
gcc/fortran/trans.h
View file

@ -309,6 +309,10 @@ tree gfc_conv_operator_assign (gfc_se *, gfc_se *, gfc_symbol *);
/* 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. */

8
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,11 @@
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.
2007-02-02 Jakub Jelinek <jakub@redhat.com>
PR c++/30536

45
gcc/testsuite/gfortran.dg/arrayio_11.f90 Normal file
View file

@ -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

42
gcc/testsuite/gfortran.dg/arrayio_12.f90 Normal file
View file

@ -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

7
libgfortran/ChangeLog
View file

@ -1,3 +1,10 @@
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-01-21 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* runtime/error.c: Include sys/time.h before sys/resource.h.

5
libgfortran/io/transfer.c
View file

@ -2013,7 +2013,7 @@ init_loop_spec (gfc_array_char *desc, array_loop_spec *ls)
index = 1;
for (i=0; i<rank; i++)
{
ls[i].idx = 1;
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;
@ -2050,8 +2050,9 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls)
else
carry = 0;
}
index = index + (ls[i].idx - 1) * ls[i].step;
index = index + (ls[i].idx - ls[i].start) * ls[i].step;
}
return index;
}