[Patch, fortran] PR31867 - function result with character LEN computed at run time
Paul Richard Thomas
paul.richard.thomas@gmail.com
Tue May 15 12:38:00 GMT 2007
: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.
-------------- next part --------------
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" } }
More information about the Fortran
mailing list