[Patch, fortran] PR31867 - function result with character LEN computed at run time

[Patch, fortran] PR31867 - function result with character LEN computed at run time

[Paul Richard Thomas]

[-- Attachment #1: Type: text/plain, Size: 2051 bytes --]

:ADDPATCH fortran:

This turns out to be a very strange bug because it is rather hard to
trigger but is, at the same time, quite central to the scalarizer.

Tobias Burnus posted this shortened testcase to the PR:

program xjoin
  implicit none
  character (len=5) :: words(2) = (/"two  ","three"/)
  write (*,*)  len(join(words)) ! should be 8 is 10
  write (*,*)  join(words)      ! valgrind error
contains
function join(words) result(str)
  character (len=*), intent(in)        :: words(:)
  character (len=sum(len_trim(words))) :: str
  str = ''
end function join
end program xjoin

The character length of 'str' is correctly calculate within the
procedure but goes wrong in the interface version that is used in the
main program.  A quick perusal of the code shows that, in this latter,
a structure "parm" is built, which is a finger-print of
trans-array.c(gfc_conv_expr_descriptor).  It is immediately noticable
that the offset field is zero, which is incorrect for the scalarized
calculation of the character length.  This is confirmed by resetting
the declaraion of words to:

  character (len=5) :: words(0:1) = (/"two  ","three"/),

whereupon the testcase works correctly.  The patch consists of
calculating the offset, using, to start, the offset stored with the
declaration and then correcting it for loops, where the stride is not
one.

As remarked above, a curious feature is the difficulty in actually
triggering this bug.  For the main part, the offset produced here is
not used.  Therefore, the testcase is a development of the reporter's
and tests various combinations of array references and strides.

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

Paul

2007-05-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31867
	* trans-array.c (gfc_conv_expr_descriptor): Obtain the stored
	offset for non-descriptor, source arrays and correct for stride
	not equal to one before writing to field of output descriptor.

2007-05-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31867
	* gfortran.dg/char_length_5.f90: New test.

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pr31867_final.diff --]
[-- Type: text/plain; name=pr31867_final.diff; charset=ANSI_X3.4-1968, Size: 4496 bytes --]

Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c	(révision 124614)
--- gcc/fortran/trans-array.c	(copie de travail)
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 4610,4615 ****
--- 4610,4617 ----
  
        if (se->direct_byref)
  	base = gfc_index_zero_node;
+       else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
+ 	base = gfc_evaluate_now (gfc_conv_array_offset (desc), &loop.pre);
        else
  	base = NULL_TREE;
  
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 4683,4690 ****
  				stride, info->stride[dim]);
  
  	  if (se->direct_byref)
! 	    base = fold_build2 (MINUS_EXPR, TREE_TYPE (base),
! 				base, stride);
  
  	  /* Store the new stride.  */
  	  tmp = gfc_conv_descriptor_stride (parm, gfc_rank_cst[dim]);
--- 4685,4704 ----
  				stride, info->stride[dim]);
  
  	  if (se->direct_byref)
! 	    {
! 	      base = fold_build2 (MINUS_EXPR, TREE_TYPE (base),
! 				  base, stride);
! 	    }
! 	  else if (GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
! 	    {
! 	      tmp = gfc_conv_array_lbound (desc, n);
! 	      tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (base),
! 				 tmp, loop.from[dim]);
! 	      tmp = fold_build2 (MULT_EXPR, TREE_TYPE (base),
! 				 tmp, gfc_conv_array_stride (desc, n));
! 	      base = fold_build2 (PLUS_EXPR, TREE_TYPE (base),
! 				  tmp, base);
! 	    }
  
  	  /* Store the new stride.  */
  	  tmp = gfc_conv_descriptor_stride (parm, gfc_rank_cst[dim]);
*************** gfc_conv_expr_descriptor (gfc_se * se, g
*** 4705,4711 ****
  	  gfc_conv_descriptor_data_set (&loop.pre, parm, offset);
  	}
  
!       if (se->direct_byref && !se->data_not_needed)
  	{
  	  /* Set the offset.  */
  	  tmp = gfc_conv_descriptor_offset (parm);
--- 4719,4726 ----
  	  gfc_conv_descriptor_data_set (&loop.pre, parm, offset);
  	}
  
!       if ((se->direct_byref || GFC_ARRAY_TYPE_P (TREE_TYPE (desc)))
! 	     && !se->data_not_needed)
  	{
  	  /* Set the offset.  */
  	  tmp = gfc_conv_descriptor_offset (parm);
Index: gcc/testsuite/gfortran.dg/char_length_5.f90
===================================================================
*** gcc/testsuite/gfortran.dg/char_length_5.f90	(révision 0)
--- gcc/testsuite/gfortran.dg/char_length_5.f90	(révision 0)
***************
*** 0 ****
--- 1,61 ----
+ ! { dg-do run }
+ ! Tests the fix for PR31867, in which the interface evaluation
+ ! of the character length of 'join' (ie. the length available in
+ ! the caller) was wrong.
+ !
+ ! Contributed by <beliavsky@aol.com> 
+ !
+ module util_mod
+   implicit none
+ contains
+   function join (words, sep) result(str)
+     character (len=*), intent(in)        :: words(:),sep
+     character (len = (size (words) - 1) * len_trim (sep) + & 
+                sum (len_trim (words)))   :: str
+     integer                              :: i,nw
+     nw  = size (words)
+     str = ""
+     if (nw < 1) then
+       return
+     else
+       str = words(1)
+     end if
+     do i=2,nw
+       str = trim (str) // trim (sep) // words(i)
+     end do
+   end function join
+ end module util_mod
+ !
+ program xjoin
+   use util_mod, only: join
+   implicit none
+   integer yy
+   character (len=5) :: words(5:8) = (/"two  ","three","four ","five "/), sep = "^#^"
+   character (len=5) :: words2(4) = (/"bat  ","ball ","goal ","stump"/), sep2 = "&"
+ 
+   if (join (words, sep) .ne. "two^#^three^#^four^#^five") call abort ()
+   if (len (join (words, sep)) .ne. 25) call abort ()
+ 
+   if (join (words(5:6), sep) .ne. "two^#^three") call abort ()
+   if (len (join (words(5:6), sep)) .ne. 11) call abort ()
+ 
+   if (join (words(7:8), sep) .ne. "four^#^five") call abort ()
+   if (len (join (words(7:8), sep)) .ne. 11) call abort ()
+ 
+   if (join (words(5:7:2), sep) .ne. "two^#^four") call abort ()
+   if (len (join (words(5:7:2), sep)) .ne. 10) call abort ()
+ 
+   if (join (words(6:8:2), sep) .ne. "three^#^five") call abort ()
+   if (len (join (words(6:8:2), sep)) .ne. 12) call abort ()
+ 
+   if (join (words2, sep2) .ne. "bat&ball&goal&stump") call abort ()
+   if (len (join (words2, sep2)) .ne. 19) call abort ()
+ 
+   if (join (words2(1:2), sep2) .ne. "bat&ball") call abort ()
+   if (len (join (words2(1:2), sep2)) .ne. 8) call abort ()
+ 
+   if (join (words2(2:4:2), sep2) .ne. "ball&stump") call abort ()
+   if (len (join (words2(2:4:2), sep2)) .ne. 10) call abort ()
+ 
+ end program xjoin
+ ! { dg-final { cleanup-modules "util_mod" } }

Re: [Patch, fortran] PR31867 - function result with character LEN computed at run time

[François-Xavier Coudert]

:REVIEWMAIL:

> 2007-05-15  Paul Thomas  <pault@gcc.gnu.org>
>
>         PR fortran/31867
>         * trans-array.c (gfc_conv_expr_descriptor): Obtain the stored
>         offset for non-descriptor, source arrays and correct for stride
>         not equal to one before writing to field of output descriptor.

I somehow lost track of this patch, sorry. This is OK for mainline,
with added testcases from PR31994.

Do you think this should go into 4.2? It doesn't appear to be a
regression, but it sure is a nasty wrong-code bug. In the end, I guess
it depends on how safe you think the patch is.

FX

Re: [Patch, fortran] PR31867 - function result with character LEN computed at run time

[Paul Richard Thomas]

FX,

> I somehow lost track of this patch, sorry. This is OK for mainline,
> with added testcases from PR31994.

Thanks - will do on the testcases.
>
> Do you think this should go into 4.2? It doesn't appear to be a
> regression, but it sure is a nasty wrong-code bug. In the end, I guess
> it depends on how safe you think the patch is.

I think that we wait a week or two to check if it causes any
regressions and then commit it to 4.2.  It is right to mark this bug
as critical in PR31994.

Paul

Re: [Patch, fortran] PR31867 - function result with character LEN computed at run time

[Paul Richard Thomas]

FX,

I duly committed the patch and kept PR31867 open for 4.2.  I added a
separate testcase fo PR31994.

Thanks for the prompt review.

Cheers

Paul