From: Paul Thomas Date: Thu, 21 Jan 2010 20:38:51 +0000 (+0000) Subject: re PR fortran/42736 (Wrong-code with allocatable or pointer components in elemental... X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3c3b62d1a51a501f66f07e528bc852f455d2e05a;p=gcc.git re PR fortran/42736 (Wrong-code with allocatable or pointer components in elemental functions) 2010-01-21 Paul Thomas 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 PR fortran/42736 * gfortran.dg/dependency_25.f90 : New test. From-SVN: r156161 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 8c8e08038ca..84dcaae64d8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2010-01-21 Paul Thomas + + 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-20 Joern Rennecke * module.c (mio_f2k_derived): Use enumerator as initializer of diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 5159f429d02..010d86f2acb 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -196,6 +196,7 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, gfc_ss *ss; gfc_ss_info *info; gfc_symbol *fsym; + gfc_ref *ref; int n; tree data; tree offset; @@ -251,6 +252,34 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, /* 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 3f6a0ce20d1..5f749784af0 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2010-01-21 Paul Thomas + + PR fortran/42736 + * gfortran.dg/dependency_25.f90 : New test. + 2010-01-21 Martin Jambor PR tree-optimization/42585 diff --git a/gcc/testsuite/gfortran.dg/dependency_25.f90 b/gcc/testsuite/gfortran.dg/dependency_25.f90 new file mode 100644 index 00000000000..25769857d76 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dependency_25.f90 @@ -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 +! Reported by Armelius Cameron +! +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" } }