From: Paul Thomas Date: Thu, 10 Jan 2008 19:10:48 +0000 (+0000) Subject: re PR fortran/34396 (Length of substrings defined by expressions not correctly comput... X-Git-Tag: releases/gcc-4.3.0~665 X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=32be9f94bfc4c7246f9091764afc55ffca2db9c9;p=thirdparty%2Fgcc.git re PR fortran/34396 (Length of substrings defined by expressions not correctly computed in constructors) 2008-01-10 Paul Thomas 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 PR fortran/34396 * gfortran.dg/bounds_check_12.f90: New test. From-SVN: r131448 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e96f612d2002..6a425317c177 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2008-01-10 Paul Thomas + + 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 PR fortran/34706 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index f8d90820f9ce..1718ba9cfae3 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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; diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index a377e19ca610..98b6fb1a3490 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -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); diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 65c65e35233a..c1de2a9fad2a 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 522abd153c99..7546770c97bd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2008-01-10 Paul Thomas + + PR fortran/34396 + * gfortran.dg/bounds_check_12.f90: New test. + 2008-01-10 Uros Bizjak * gcc.target/i386/cmov7.c: Add -mbranch-cost=5 to dg-options. diff --git a/gcc/testsuite/gfortran.dg/bounds_check_12.f90 b/gcc/testsuite/gfortran.dg/bounds_check_12.f90 new file mode 100644 index 000000000000..f671badbaa51 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/bounds_check_12.f90 @@ -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 +! +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" }