This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
Re: [Patch, fortran] PR42736 - [4.3/4.4/4.5 Regression] Wrong-code with allocatable or pointer components in elemental functions
Jakub, I CCed you to ask whether this patch can still go in for 4.4.3 or
whether we should wait for 4.4.4?
Dear Paul,
On 01/21/2010 09:58 AM, Paul Richard Thomas wrote:
> Thank you for this review of the NULL patch. I have taken your
> proposed corrections into account.
>
That is very kind of you.
> Below, you will find the modified function
> trans-stmt.c(gfc_conv_elemental_dependencies) (a corrected version of
> what I sent you last night).
>
Based on your two emails I have created a proper patch out of it, cf.
attachment.
> Bootstrapped and regtested on FC9/x86_64 - OK for trunk, then 4.4 and 4.3?
OK and thanks for the patch. Regarding 4.4: As there is a 4.4.3rc, you
need to wait for either an approval by a release manager or wait until
4.4.3 is tagged.
Tobias
PS: In the last whitespace change (~line 231) you changed trailing
spaces into a trailing tab, which I have corrected in my diff.
2010-01-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/42736
* trans-stmt.c (gfc_conv_elemental_dependencies): If temporary
is required, turn any trailing array elements after a range
into ranges so that offsets can be calculated.
2010-01-21 Paul Thomas <pault@gcc.gnu.org>
PR fortran/42736
* gfortran.dg/dependency_25.f90 : New test.
Index: gcc/fortran/trans-stmt.c
===================================================================
--- gcc/fortran/trans-stmt.c (revision 156087)
+++ gcc/fortran/trans-stmt.c (working copy)
@@ -196,6 +196,7 @@ gfc_conv_elemental_dependencies (gfc_se
gfc_ss *ss;
gfc_ss_info *info;
gfc_symbol *fsym;
+ gfc_ref *ref;
int n;
tree data;
tree offset;
@@ -216,7 +217,7 @@ gfc_conv_elemental_dependencies (gfc_se
if (e == NULL)
continue;
- /* Obtain the info structure for the current argument. */
+ /* Obtain the info structure for the current argument. */
info = NULL;
for (ss = loopse->ss; ss && ss != gfc_ss_terminator; ss = ss->next)
{
@@ -251,6 +252,33 @@ gfc_conv_elemental_dependencies (gfc_se
/* Obtain the argument descriptor for unpacking. */
gfc_init_se (&parmse, NULL);
parmse.want_pointer = 1;
+
+ /* The scalarizer introduces some specific peculiarities when
+ handling elemental subroutines; the stride can be needed up to
+ the dim_array - 1, rather than dim_loop - 1 to calculate
+ offsets outside the loop. For this reason, we make sure that
+ the descriptor has the dimensionality of the array by converting
+ trailing elements into ranges with end = start. */
+ for (ref = e->ref; ref; ref = ref->next)
+ if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+ break;
+
+ if (ref)
+ {
+ bool seen_range = false;
+ for (n = 0; n < ref->u.ar.dimen; n++)
+ {
+ if (ref->u.ar.dimen_type[n] == DIMEN_RANGE)
+ seen_range = true;
+
+ if (!seen_range || ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+ continue;
+
+ ref->u.ar.end[n] = gfc_copy_expr (ref->u.ar.start[n]);
+ ref->u.ar.dimen_type[n] = DIMEN_RANGE;
+ }
+ }
+
gfc_conv_expr_descriptor (&parmse, e, gfc_walk_expr (e));
gfc_add_block_to_block (&se->pre, &parmse.pre);
@@ -300,7 +328,7 @@ gfc_conv_elemental_dependencies (gfc_se
offset = fold_build2 (MINUS_EXPR, gfc_array_index_type,
offset, tmp);
}
- info->offset = gfc_create_var (gfc_array_index_type, NULL);
+ info->offset = gfc_create_var (gfc_array_index_type, NULL);
gfc_add_modify (&se->pre, info->offset, offset);
/* Copy the result back using unpack. */
Index: gcc/testsuite/gfortran.dg/dependency_25.f90
===================================================================
--- gcc/testsuite/gfortran.dg/dependency_25.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/dependency_25.f90 (revision 0)
@@ -0,0 +1,95 @@
+! { dg-do run }
+! Test the fix for PR42736, in which an excessively rigorous dependency
+! checking for the assignment generated an unnecessary temporary, whose
+! rank was wrong. When accessed by the scalarizer, a segfault ensued.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+! Reported by Armelius Cameron <armeliusc@gmail.com>
+!
+module UnitValue_Module
+
+ implicit none
+ private
+
+ public :: &
+ operator(*), &
+ assignment(=)
+
+ type, public :: UnitValue
+ real :: &
+ Value = 1.0
+ character(31) :: &
+ Label
+ end type UnitValue
+
+ interface operator(*)
+ module procedure ProductReal_LV
+ end interface operator(*)
+
+ interface assignment(=)
+ module procedure Assign_LV_Real
+ end interface assignment(=)
+
+contains
+
+ elemental function ProductReal_LV(Multiplier, Multiplicand) result(P_R_LV)
+
+ real, intent(in) :: &
+ Multiplier
+ type(UnitValue), intent(in) :: &
+ Multiplicand
+ type(UnitValue) :: &
+ P_R_LV
+
+ P_R_LV%Value = Multiplier * Multiplicand%Value
+ P_R_LV%Label = Multiplicand%Label
+
+ end function ProductReal_LV
+
+
+ elemental subroutine Assign_LV_Real(LeftHandSide, RightHandSide)
+
+ real, intent(inout) :: &
+ LeftHandSide
+ type(UnitValue), intent(in) :: &
+ RightHandSide
+
+ LeftHandSide = RightHandSide%Value
+
+ end subroutine Assign_LV_Real
+
+end module UnitValue_Module
+
+program TestProgram
+
+ use UnitValue_Module
+
+ implicit none
+
+ type :: TableForm
+ real, dimension(:,:), allocatable :: &
+ RealData
+ end type TableForm
+
+ type(UnitValue) :: &
+ CENTIMETER
+
+ type(TableForm), pointer :: &
+ Table
+
+ allocate(Table)
+ allocate(Table%RealData(10,5))
+
+ CENTIMETER%value = 42
+ Table%RealData = 1
+ Table%RealData(:,1) = Table%RealData(:,1) * CENTIMETER
+ Table%RealData(:,2) = Table%RealData(:,2) * CENTIMETER
+ Table%RealData(:,3) = Table%RealData(:,3) * CENTIMETER
+ Table%RealData(:,5) = Table%RealData(:,5) * CENTIMETER
+
+! print *, Table%RealData
+ if (any (abs(Table%RealData(:,4) - 1) > epsilon(1.0))) call abort ()
+ if (any (abs(Table%RealData(:,[1,2,3,5]) - 42) > epsilon(1.0))) call abort ()
+end program TestProgram
+
+! { dg-final { cleanup-modules "UnitValue_Module" } }