diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e8649c352341a852b15707ff94e6c4ad178ae053..3ee0a28ba0a1b6e02c2f0b16adfd6ec4fd1d5f98 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 487b6a7d2ab3242eaafca7c33f84b28ccaab40ab..723ffabacb8c05af5e706520c1b3ae80e2dd168f 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -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;
diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c
index 654c0fad8079d925ce7653e80b9de1a383eeb592..9865f44c3312a40568415ca89a2f5c3e3170f047 100644
--- a/gcc/fortran/trans-io.c
+++ b/gcc/fortran/trans-io.c
@@ -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;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index a3b6f04780be316a9d422f38cd02a08f0ca694b1..a66ad39f2e2e3bfe3ea4a13eae7b043d32479cd5 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -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. */
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 1a4616814690f20e3cd2c2b6ea79c41e2a51fc90..de2915922c45200cf62916768de10875bfca4157 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/arrayio_11.f90 b/gcc/testsuite/gfortran.dg/arrayio_11.f90
new file mode 100644
index 0000000000000000000000000000000000000000..39255dbcdaef4143ecd29c25bf1dd2d2db031803
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_11.f90
@@ -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
diff --git a/gcc/testsuite/gfortran.dg/arrayio_12.f90 b/gcc/testsuite/gfortran.dg/arrayio_12.f90
new file mode 100644
index 0000000000000000000000000000000000000000..ca010479bd2d894dde4f2ee4b65f64bb411d588a
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/arrayio_12.f90
@@ -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
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index d432812fe590741f10d2c97a2f01269414dd4c8e..4f5eed45d52cde6bd3b23bfafe952882b7d9032c 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -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.
diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index ddf5d00dac1afa11ce9e282c0c8badf408c1789c..a7632da55ae913dbfad2be18fd9fc19b1e8f8aaf 100644
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -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;
}