From: pault Date: Fri, 2 Feb 2007 12:35:57 +0000 (+0000) Subject: 2007-02-02 Paul Thomas X-Git-Tag: upstream/4.9.2~50652 X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=2ecf364f9874ef6259c056e6e4f454227130e15c;p=platform%2Fupstream%2Flinaro-gcc.git 2007-02-02 Paul Thomas 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 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 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 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e8649c3..3ee0a28 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,19 @@ +2007-02-02 Paul Thomas + + 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 * 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 487b6a7..723ffab 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 654c0fa..9865f44 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 a3b6f04..a66ad39 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 1a46168..de29159 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2007-02-02 Paul Thomas + + 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 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 0000000..39255db --- /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 + +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 0000000..ca01047 --- /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 + +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 d432812..4f5eed4 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2007-02-02 Paul Thomas + + 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 * runtime/error.c: Include sys/time.h before sys/resource.h. diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c index ddf5d00..a7632da 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; idim[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; }