MatCat.OpenSource/8sa1-gcc
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

PR95331 - Unlimited polymorphic arrays have wrong bounds.

Browse Source 
When iterating over a class array use the bounds provided by the
transformed descriptor (in sym->backend_decl) instead of the original
bounds of the array (in the descriptor passed in the class _data)
which are passed in se->expr.

The patch partially depends on the patch for PR52351 and PR85868, but
does not seems to break anything by itself.

gcc/fortran/ChangeLog:

2020-06-11  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

	PR fortran/95331
	* trans-array.c (gfc_conv_array_ref): For class array dummy
	arguments use the transformed descriptor in sym->backend_decl
	instead of the original descriptor.

gcc/testsuite/ChangeLog:

2020-06-11  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

	PR fortran/95331
	* gfortran.dg/PR95331.f90: New test.
This commit is contained in:
José Rui Faustino de Sousa 2020-06-11 15:15:25 +02:00 committed by Thomas Koenig
parent 19019cd301
commit 2ee70f5d16
2 changed files with 172 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
gcc/fortran/trans-array.c
View File

@ -3672,8 +3672,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
}
}
decl = se->expr;
if (IS_CLASS_ARRAY (sym) && sym->attr.dummy && ar->as->type != AS_DEFERRED)
decl = sym->backend_decl;
cst_offset = offset = gfc_index_zero_node;
add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (se->expr));
add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (decl));
/* Calculate the offsets from all the dimensions. Make sure to associate
the final offset so that we form a chain of loop invariant summands. */
@ -3694,7 +3698,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
indexse.expr = save_expr (indexse.expr);
/* Lower bound. */
tmp = gfc_conv_array_lbound (se->expr, n);
tmp = gfc_conv_array_lbound (decl, n);
if (sym->attr.temporary)
{
gfc_init_se (&tmpse, se);
@ -3718,7 +3722,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
arrays. */
if (n < ar->dimen - 1 || ar->as->type != AS_ASSUMED_SIZE)
{
tmp = gfc_conv_array_ubound (se->expr, n);
tmp = gfc_conv_array_ubound (decl, n);
if (sym->attr.temporary)
{
gfc_init_se (&tmpse, se);
@ -3741,7 +3745,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
}
/* Multiply the index by the stride. */
stride = gfc_conv_array_stride (se->expr, n);
stride = gfc_conv_array_stride (decl, n);
tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
indexse.expr, stride);
@ -3756,6 +3760,7 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
/* A pointer array component can be detected from its field decl. Fix
the descriptor, mark the resulting variable decl and pass it to
build_array_ref. */
decl = NULL_TREE;
if (get_CFI_desc (sym, expr, &decl, ar))
decl = build_fold_indirect_ref_loc (input_location, decl);
if (!expr->ts.deferred && !sym->attr.codimension

163
gcc/testsuite/gfortran.dg/PR95331.f90 Normal file
View File

@ -0,0 +1,163 @@
! { dg-do run }
!
! PR fortran/95331
!
program main_p
implicit none
integer, parameter :: n = 10
integer, parameter :: m = 5
integer, parameter :: b = 3
integer, parameter :: t = n+b-1
integer, parameter :: l = 4
integer, parameter :: u = 7
integer, parameter :: s = 3
integer, parameter :: e = (u-l)/s+1
call test_f()
call test_s()
call test_p()
call test_a()
stop
contains
subroutine test_f()
integer :: x(n,n)
integer :: y(b:t)
integer :: i
x = reshape([(i, i=1,n*n)], [n,n])
y = x(:,m)
call sub_s(x(:,m), y, n)
call sub_s(y, x(:,m), n)
return
end subroutine test_f
subroutine test_s()
integer :: x(n,n)
integer :: v(e)
integer :: i
x = reshape([(i, i=1,n*n)], [n,n])
v = x(l:u:s,m)
call sub_s(v, v, e)
call sub_s(x(l:u:s,m), v, e)
call sub_s(v, x(l:u:s,m), e)
return
end subroutine test_s
subroutine test_p()
integer, target :: x(n,n)
integer, pointer :: p(:)
integer :: v(e)
integer :: i
x = reshape([(i, i=1,n*n)], [n,n])
v = x(l:u:s,m)
p => x(:,m)
call sub_s(p(l:u:s), v, e)
p => x(l:u:s,m)
call sub_s(p, v, e)
p(l:) => x(l:u:s,m)
call sub_s(p, v, e)
p(l:l+e-1) => x(l:u:s,m)
call sub_s(p, v, e)
allocate(p(n))
p(:) = x(:,m)
call sub_s(p(l:u:s), v, e)
deallocate(p)
allocate(p(e))
p(:) = x(l:u:s,m)
call sub_s(p, v, e)
deallocate(p)
allocate(p(l:l+e-1))
p(:) = x(l:u:s,m)
call sub_s(p, v, e)
deallocate(p)
allocate(p(l:l+e-1))
p(l:) = x(l:u:s,m)
call sub_s(p, v, e)
deallocate(p)
allocate(p(l:l+e-1))
p(l:l+e-1) = x(l:u:s,m)
call sub_s(p, v, e)
deallocate(p)
return
end subroutine test_p
subroutine test_a()
integer :: x(n,n)
integer, allocatable :: a(:)
integer :: v(e)
integer :: i
x = reshape([(i, i=1,n*n)], [n,n])
v = x(l:u:s,m)
a = x(:,m)
call sub_s(a(l:u:s), v, e)
deallocate(a)
allocate(a(n))
a(:) = x(:,m)
call sub_s(a(l:u:s), v, e)
deallocate(a)
a = x(l:u:s,m)
call sub_s(a, v, e)
deallocate(a)
allocate(a(e))
a(:) = x(l:u:s,m)
call sub_s(a, v, e)
deallocate(a)
allocate(a(l:l+e-1))
a(:) = x(l:u:s,m)
call sub_s(a, v, e)
deallocate(a)
allocate(a(l:l+e-1))
a(l:) = x(l:u:s,m)
call sub_s(a, v, e)
deallocate(a)
allocate(a(l:l+e-1))
a(l:l+e-1) = x(l:u:s,m)
call sub_s(a, v, e)
deallocate(a)
return
end subroutine test_a
subroutine sub_s(a, b, n)
class(*), intent(in) :: a(:)
integer, intent(in) :: b(:)
integer, intent(in) :: n
integer :: i
if(lbound(a, dim=1)/=1) stop 1001
if(ubound(a, dim=1)/=n) stop 1002
if(any(shape(a)/=[n])) stop 1003
if(size(a, dim=1)/=n) stop 1004
if(size(a)/=size(b)) stop 1005
do i = 1, n
call vrfy(a(i), b(i))
end do
return
end subroutine sub_s
subroutine vrfy(a, b)
class(*), intent(in) :: a
integer, intent(in) :: b
select type (a)
type is (integer)
!print *, a, b
if(a/=b) stop 2001
class default
STOP 2002
end select
return
end subroutine vrfy
end program main_p