Commit e519d2e8 by Paul Thomas

re PR fortran/84074 (Incorrect indexing of array when actual argument is an…

re PR fortran/84074 (Incorrect indexing of array when actual argument is an array expression and dummy is polymorphic)

2018-02-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84074
	* trans-expr.c (gfc_conv_derived_to_class): Set the use_offset
	flag. If the is a vector subscript or the expression is not a
	variable, make the descriptor one-based.

2018-02-11  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/84074
	* gfortran.dg/type_to_class_5.f03: New test.

From-SVN: r257564
parent e094c0bf
2018-02-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84074
* trans-expr.c (gfc_conv_derived_to_class): Set the use_offset
flag. If the is a vector subscript or the expression is not a
variable, make the descriptor one-based.
2018-02-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84141
......
......@@ -547,6 +547,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
tree ctree;
tree var;
tree tmp;
int dim;
/* The derived type needs to be converted to a temporary
CLASS object. */
......@@ -636,10 +637,34 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e,
{
stmtblock_t block;
gfc_init_block (&block);
gfc_ref *ref;
parmse->ss = ss;
parmse->use_offset = 1;
gfc_conv_expr_descriptor (parmse, e);
/* Detect any array references with vector subscripts. */
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY
&& ref->u.ar.type != AR_ELEMENT
&& ref->u.ar.type != AR_FULL)
{
for (dim = 0; dim < ref->u.ar.dimen; dim++)
if (ref->u.ar.dimen_type[dim] == DIMEN_VECTOR)
break;
if (dim < ref->u.ar.dimen)
break;
}
/* Array references with vector subscripts and non-variable expressions
need be coverted to a one-based descriptor. */
if (ref || e->expr_type != EXPR_VARIABLE)
{
for (dim = 0; dim < e->rank; ++dim)
gfc_conv_shift_descriptor_lbound (&block, parmse->expr, dim,
gfc_index_one_node);
}
if (e->rank != class_ts.u.derived->components->as->rank)
{
gcc_assert (class_ts.u.derived->components->as->type
......@@ -10105,7 +10130,7 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag,
&expr1->where, msg);
}
/* Deallocate the lhs parameterized components if required. */
/* Deallocate the lhs parameterized components if required. */
if (dealloc && expr2->expr_type == EXPR_FUNCTION
&& !expr1->symtree->n.sym->attr.associate_var)
{
......
2018-02-11 Paul Thomas <pault@gcc.gnu.org>
PR fortran/84074
* gfortran.dg/type_to_class_5.f03: New test.
2018-02-10 Paul Thomas <pault@gcc.gnu.org>
PR fortran/56691
......
! { dg-do run }
!
! Test the fix for PR84074
!
! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
!
type :: t
integer :: n
end type
type(t) :: array(4) = [t(1),t(2),t(3),t(4)]
call sub(array((/3,1/)), [3,1,0,0]) ! Does not increment any elements of 'array'.
call sub(array(1:3:2), [1,3,0,0])
call sub(array(3:1:-2), [4,2,0,0])
call sub(array, [3,2,5,4]) ! Elements 1 and 3 should have been incremented twice.
contains
subroutine sub(a, iarray)
class(t) :: a(:)
integer :: iarray(4)
integer :: i
do i=1,size(a)
if (a(i)%n .ne. iarray(i)) call abort
a(i)%n = a(i)%n+1
enddo
end subroutine
end program
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment