procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/43829 (Scalarization of reductions)

Browse source 
2010-04-22  Richard Guenther  <rguenther@suse.de>

	PR fortran/43829
	* resolve.c (gfc_resolve_index): Wrap around ...
	(gfc_resolve_index_1): ... this.  Add parameter to allow
	any integer kind index type.
	(resolve_array_ref): Allow any integer kind for the start
	index of an array ref.

	* gfortran.dg/vector_subscript_6.f90: New testcase.
	* gfortran.dg/assign_10.f90: Adjust.

From-SVN: r158632
This commit is contained in:
Richard Guenther 2010-04-22 08:34:41 +00:00 • committed by Richard Biener
parent c334c130bd
commit 92375a2020
6 changed files with 70 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -1,3 +1,12 @@
2010-04-22 Richard Guenther <rguenther@suse.de>
PR fortran/43829
* resolve.c (gfc_resolve_index): Wrap around ...
(gfc_resolve_index_1): ... this. Add parameter to allow
any integer kind index type.
(resolve_array_ref): Allow any integer kind for the start
index of an array ref.
2010-04-21 Jakub Jelinek <jakub@redhat.com>
PR fortran/43836

21
gcc/fortran/resolve.c
View file

@ -3978,8 +3978,9 @@ compare_spec_to_ref (gfc_array_ref *ar)
/* Resolve one part of an array index. */
gfc_try
gfc_resolve_index (gfc_expr *index, int check_scalar)
static gfc_try
gfc_resolve_index_1 (gfc_expr *index, int check_scalar,
int force_index_integer_kind)
{
gfc_typespec ts;
@ -4007,7 +4008,8 @@ gfc_resolve_index (gfc_expr *index, int check_scalar)
&index->where) == FAILURE)
return FAILURE;
if (index->ts.kind != gfc_index_integer_kind
if ((index->ts.kind != gfc_index_integer_kind
&& force_index_integer_kind)
|| index->ts.type != BT_INTEGER)
{
gfc_clear_ts (&ts);
@ -4020,6 +4022,14 @@ gfc_resolve_index (gfc_expr *index, int check_scalar)
return SUCCESS;
}
/* Resolve one part of an array index. */
gfc_try
gfc_resolve_index (gfc_expr *index, int check_scalar)
{
return gfc_resolve_index_1 (index, check_scalar, 1);
}
/* Resolve a dim argument to an intrinsic function. */
gfc_try
@ -4144,7 +4154,10 @@ resolve_array_ref (gfc_array_ref *ar)
{
check_scalar = ar->dimen_type[i] == DIMEN_RANGE;
if (gfc_resolve_index (ar->start[i], check_scalar) == FAILURE)
/* Do not force gfc_index_integer_kind for the start. We can
do fine with any integer kind. This avoids temporary arrays
created for indexing with a vector. */
if (gfc_resolve_index_1 (ar->start[i], check_scalar, 0) == FAILURE)
return FAILURE;
if (gfc_resolve_index (ar->end[i], check_scalar) == FAILURE)
return FAILURE;

1
gcc/fortran/trans-array.c
View file

@ -2434,6 +2434,7 @@ gfc_conv_array_index_offset (gfc_se * se, gfc_ss_info * info, int dim, int i,
gfc_conv_array_data (desc));
index = gfc_build_array_ref (data, index, NULL);
index = gfc_evaluate_now (index, &se->pre);
index = fold_convert (gfc_array_index_type, index);
/* Do any bounds checking on the final info->descriptor index. */
index = gfc_trans_array_bound_check (se, info->descriptor,

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2010-04-22 Richard Guenther <rguenther@suse.de>
PR fortran/43829
* gfortran.dg/vector_subscript_6.f90: New testcase.
* gfortran.dg/assign_10.f90: Adjust.
2010-04-21 Jakub Jelinek <jakub@redhat.com>
PR fortran/43836

8
gcc/testsuite/gfortran.dg/assign_10.f90
View file

@ -19,10 +19,10 @@
if (any(p8 .ne. q8)) call abort ()
end
! Whichever is the default length for array indices will yield
! parm 9 times, because a temporary is not necessary. The other
! cases will all yield a temporary, so that atmp appears 27 times.
! parm 18 times, because a temporary is not necessary. The other
! cases will all yield a temporary, so that atmp appears 18 times.
! Note that it is the kind conversion that generates the temp.
!
! { dg-final { scan-tree-dump-times "parm" 9 "original" } }
! { dg-final { scan-tree-dump-times "atmp" 27 "original" } }
! { dg-final { scan-tree-dump-times "parm" 18 "original" } }
! { dg-final { scan-tree-dump-times "atmp" 18 "original" } }
! { dg-final { cleanup-tree-dump "original" } }

33
gcc/testsuite/gfortran.dg/vector_subscript_6.f90 Normal file
View file

@ -0,0 +1,33 @@
! { dg-do compile }
! { dg-options "-fdump-tree-original" }
subroutine test0(esss,Ix, e_x)
real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
integer(kind=kind(1)), dimension(:), intent(in) :: e_x
esss = Ix(e_x)
end subroutine
subroutine test1(esss,Ix, e_x)
real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
integer(kind=4), dimension(:), intent(in) :: e_x
esss = Ix(e_x)
end subroutine
subroutine test2(esss,Ix, e_x)
real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix
integer(kind=8), dimension(:), intent(in) :: e_x
esss = Ix(e_x)
end subroutine
subroutine test3(esss,Ix,Iyz, e_x, ii_ivec)
real(kind=kind(1.0d0)), dimension(:), intent(out) :: esss
real(kind=kind(1.0d0)), dimension(:), intent(in) :: Ix,Iyz
integer(kind=kind(1)), dimension(:), intent(in) :: e_x,ii_ivec
esss = esss + Ix(e_x) * Iyz(ii_ivec)
end subroutine
! { dg-final { scan-tree-dump-not "malloc" "original" } }
! { dg-final { cleanup-tree-dump "original" } }