[Patch, fortran] PR34396 - Length of substrings defined by expressions not correctly computed in constructors

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

:ADDPATCH fortran:

This one consisted of two bugs:

(i) The assignment from the constructor to the array elements did not
pad out the result with spaces.  This was cured by borrowing
gfc_trans_string_copy from trans-expr.c.
(ii) The bounds checking was not working correctly.  This was fixed by
moving it to  gfc_trans_array_ctor_element, where the string length
must be calculate for each element.

The testcase is essentially the reporter's.

Bootstrapped and regtested on x86_ia64/FC8 - OK for trunk?

Paul

2008-01-09  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-09  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/34396
	* gfortran.dg/bounds_check_12.f90: New test.

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(revision 131363)
--- gcc/fortran/trans-array.c	(working copy)
*************** gfc_put_offset_into_var (stmtblock_t * p
*** 951,968 ****
--- 951,975 ----
  
  
  /* 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);
*************** gfc_trans_array_ctor_element (stmtblock_
*** 978,986 ****
  	  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);
  	}
      }
    else
--- 985,1014 ----
  	  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.  */
! 	  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
*************** bool
*** 1425,1431 ****
  get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
  {
    bool is_const;
-   tree first_len = NULL_TREE;
    
    is_const = TRUE;
  
--- 1453,1458 ----
*************** get_array_ctor_strlen (stmtblock_t *bloc
*** 1460,1482 ****
  	  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;
--- 1487,1492 ----
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1660,1665 ****
--- 1670,1681 ----
    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;
Index: gcc/fortran/trans-array.h
===================================================================
*** gcc/fortran/trans-array.h	(revision 131363)
--- gcc/fortran/trans-array.h	(working copy)
*************** void gfc_add_intrinsic_ss_code (gfc_loop
*** 137,139 ****
--- 137,142 ----
  /* 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);
Index: gcc/fortran/trans-expr.c
===================================================================
*** gcc/fortran/trans-expr.c	(revision 131363)
--- gcc/fortran/trans-expr.c	(working copy)
*************** gfc_conv_function_call (gfc_se * se, gfc
*** 2803,2809 ****
  
  /* Generate code to copy a string.  */
  
! static void
  gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
  		       tree slength, tree src)
  {
--- 2803,2809 ----
  
  /* Generate code to copy a string.  */
  
! void
  gfc_trans_string_copy (stmtblock_t * block, tree dlength, tree dest,
  		       tree slength, tree src)
  {
Index: gcc/testsuite/gfortran.dg/bounds_check_12.f90
===================================================================
*** gcc/testsuite/gfortran.dg/bounds_check_12.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/bounds_check_12.f90	(revision 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" }