re PR fortran/34396 (Length of substrings defined by expressions not correctly comput...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e96f612d2002737e9d09169f3094064cb94f2466..6a425317c1773d86ae1653248b5d874188be7499 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index f8d90820f9cee051492026cfad98211b1a252394..1718ba9cfae369014ac9ec4eb7b76387a5813841 100644 (file)
--- 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 a377e19ca61083c76629deb6de68976da4e991fd..98b6fb1a3490d7770c160ad4f70c35598241b29e 100644 (file)
--- 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 65c65e35233af08a7cbbc174a3b4510895d2a8a8..c1de2a9fad2a880e3caec3666f8e21bd89603662 100644 (file)
--- 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 522abd153c9952ff810ec4019c0b87c543dc1d2e..7546770c97bda9af69421e5b793bc42cef5b8bcd 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/bounds_check_12.f90 b/gcc/testsuite/gfortran.dg/bounds_check_12.f90
new file mode 100644 (file)
index 0000000..f671bad
--- /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 <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" }