re PR fortran/34396 (Length of substrings defined by expressions not correctly computed in constructors)
2008-01-10 Paul Thomas <pault@gcc.gnu.org> PR fortran/34396 * trans-array.c (gfc_trans_array_ctor_element): Use gfc_trans_string_copy to assign strings and perform bounds checks on the string length. (get_array_ctor_strlen): Remove bounds checking. (gfc_trans_array_constructor): Initialize string length checking. * trans-array.h : Add prototype for gfc_trans_string_copy. 2008-01-10 Paul Thomas <pault@gcc.gnu.org> PR fortran/34396 * gfortran.dg/bounds_check_12.f90: New test. From-SVN: r131448
This commit is contained in:
parent
814252befa
commit
32be9f94bf
|
@ -1,3 +1,12 @@
|
|||
2008-01-10 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/34396
|
||||
* trans-array.c (gfc_trans_array_ctor_element): Use gfc_trans_string_copy
|
||||
to assign strings and perform bounds checks on the string length.
|
||||
(get_array_ctor_strlen): Remove bounds checking.
|
||||
(gfc_trans_array_constructor): Initialize string length checking.
|
||||
* trans-array.h : Add prototype for gfc_trans_string_copy.
|
||||
|
||||
2008-01-08 Richard Guenther <rguenther@suse.de>
|
||||
|
||||
PR fortran/34706
|
||||
|
|
|
@ -951,18 +951,25 @@ gfc_put_offset_into_var (stmtblock_t * pblock, tree * poffset,
|
|||
|
||||
|
||||
/* Assign an element of an array constructor. */
|
||||
static bool first_len;
|
||||
static tree first_len_val;
|
||||
|
||||
static void
|
||||
gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
|
||||
tree offset, gfc_se * se, gfc_expr * expr)
|
||||
{
|
||||
tree tmp;
|
||||
tree esize;
|
||||
|
||||
gfc_conv_expr (se, expr);
|
||||
|
||||
/* Store the value. */
|
||||
tmp = build_fold_indirect_ref (gfc_conv_descriptor_data_get (desc));
|
||||
tmp = gfc_build_array_ref (tmp, offset, NULL);
|
||||
|
||||
esize = size_in_bytes (gfc_get_element_type (TREE_TYPE (desc)));
|
||||
esize = fold_convert (gfc_charlen_type_node, esize);
|
||||
|
||||
if (expr->ts.type == BT_CHARACTER)
|
||||
{
|
||||
gfc_conv_string_parameter (se);
|
||||
|
@ -978,9 +985,30 @@ gfc_trans_array_ctor_element (stmtblock_t * pblock, tree desc,
|
|||
tmp = gfc_build_addr_expr (pchar_type_node, tmp);
|
||||
/* We know the temporary and the value will be the same length,
|
||||
so can use memcpy. */
|
||||
tmp = build_call_expr (built_in_decls[BUILT_IN_MEMCPY], 3,
|
||||
tmp, se->expr, se->string_length);
|
||||
gfc_add_expr_to_block (&se->pre, tmp);
|
||||
gfc_trans_string_copy (&se->pre, esize, tmp,
|
||||
se->string_length,
|
||||
se->expr);
|
||||
}
|
||||
if (flag_bounds_check)
|
||||
{
|
||||
if (first_len)
|
||||
{
|
||||
gfc_add_modify_expr (&se->pre, first_len_val,
|
||||
se->string_length);
|
||||
first_len = false;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* Verify that all constructor elements are of the same
|
||||
length. */
|
||||
tree cond = fold_build2 (NE_EXPR, boolean_type_node,
|
||||
first_len_val, se->string_length);
|
||||
gfc_trans_runtime_check
|
||||
(cond, &se->pre, &expr->where,
|
||||
"Different CHARACTER lengths (%ld/%ld) in array constructor",
|
||||
fold_convert (long_integer_type_node, first_len_val),
|
||||
fold_convert (long_integer_type_node, se->string_length));
|
||||
}
|
||||
}
|
||||
}
|
||||
else
|
||||
|
@ -1425,7 +1453,6 @@ bool
|
|||
get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
|
||||
{
|
||||
bool is_const;
|
||||
tree first_len = NULL_TREE;
|
||||
|
||||
is_const = TRUE;
|
||||
|
||||
|
@ -1460,23 +1487,6 @@ get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
|
|||
get_array_ctor_all_strlen (block, c->expr, len);
|
||||
break;
|
||||
}
|
||||
if (flag_bounds_check)
|
||||
{
|
||||
if (!first_len)
|
||||
first_len = *len;
|
||||
else
|
||||
{
|
||||
/* Verify that all constructor elements are of the same
|
||||
length. */
|
||||
tree cond = fold_build2 (NE_EXPR, boolean_type_node,
|
||||
first_len, *len);
|
||||
gfc_trans_runtime_check
|
||||
(cond, block, &c->expr->where,
|
||||
"Different CHARACTER lengths (%ld/%ld) in array constructor",
|
||||
fold_convert (long_integer_type_node, first_len),
|
||||
fold_convert (long_integer_type_node, *len));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return is_const;
|
||||
|
@ -1660,6 +1670,12 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss)
|
|||
tree type;
|
||||
bool dynamic;
|
||||
|
||||
if (flag_bounds_check && ss->expr->ts.type == BT_CHARACTER)
|
||||
{
|
||||
first_len_val = gfc_create_var (gfc_charlen_type_node, "len");
|
||||
first_len = true;
|
||||
}
|
||||
|
||||
ss->data.info.dimen = loop->dimen;
|
||||
|
||||
c = ss->expr->value.constructor;
|
||||
|
|
|
@ -137,3 +137,6 @@ void gfc_add_intrinsic_ss_code (gfc_loopinfo *, gfc_ss *);
|
|||
/* Functions for constant array constructor processing. */
|
||||
unsigned HOST_WIDE_INT gfc_constant_array_constructor_p (gfc_constructor *);
|
||||
tree gfc_build_constant_array_constructor (gfc_expr *, tree);
|
||||
|
||||
/* Copy a string from src to dest. */
|
||||
void gfc_trans_string_copy (stmtblock_t *, tree, tree, tree, tree);
|
||||
|
|
|
@ -2803,7 +2803,7 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
|
|||
|
||||
/* Generate code to copy a string. */
|
||||
|
||||
static void
|
||||
void
|
||||
gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
|
||||
tree slength, tree src)
|
||||
{
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2008-01-10 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/34396
|
||||
* gfortran.dg/bounds_check_12.f90: New test.
|
||||
|
||||
2008-01-10 Uros Bizjak <ubizjak@gmail.com>
|
||||
|
||||
* gcc.target/i386/cmov7.c: Add -mbranch-cost=5 to dg-options.
|
||||
|
|
|
@ -0,0 +1,28 @@
|
|||
! { dg-do run }
|
||||
! { dg-options "-fbounds-check" }
|
||||
! { dg-shouldfail "Different CHARACTER lengths" }
|
||||
! Tests the fix for PR34396, where the non-constant string lengths in the
|
||||
! array constructor were being ignored and the bounds checking was not
|
||||
! being done correctly.
|
||||
!
|
||||
! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
|
||||
!
|
||||
program array_char
|
||||
implicit none
|
||||
integer :: i, j(5)
|
||||
character (len=5) :: x, y
|
||||
character (len=5) :: z(2)
|
||||
x = "ab"
|
||||
y = "cd"
|
||||
z = ""
|
||||
z = (/y(1: len (trim(y))), x(1: len (trim(x)))/)
|
||||
j = ichar ([(z(1)(i:i), i=1,5)])
|
||||
if (any (j .ne. (/99,100,32,32,32/))) call abort ()
|
||||
j = ichar ([(z(2)(i:i), i=1,5)])
|
||||
if (any (j .ne. (/97,98,32,32,32/))) call abort ()
|
||||
x = "a "
|
||||
z = (/y(1: len (trim(y))), x(1: len (trim(x)))/)
|
||||
end program array_char
|
||||
|
||||
! { dg-output "At line 24 of file .*" }
|
||||
! { dg-output "Different CHARACTER lengths .2/1. in array constructor" }
|
Loading…
Reference in New Issue