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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@121500
138bc75d-0d04-0410-961f-
82ee72b054a4
+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
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)
{
{
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;
/* 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;
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;
{
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 ();
/* 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;
}
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;
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");
{
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
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;
/* 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. */
+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
--- /dev/null
+! { 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
--- /dev/null
+! { 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
+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.
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;
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;
}
projects / platform / upstream / linaro-gcc.git / commitdiff