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

re PR fortran/51250 (Bug with SUM(,dim,mask))

Browse source 
fortran/
	PR fortran/51250
	PR fortran/43829
	* trans-array.c (gfc_trans_create_temp_array): Get dimension from
	the right gfc_ss struct.

testsuite/
	PR fortran/51250
	PR fortran/43829
	* gfortran.dg/inline_sum_3.f90: New test.

From-SVN: r181730
This commit is contained in:
Mikael Morin 2011-11-25 20:18:21 +00:00
parent 9e08718a4a
commit f6a40ccda3
4 changed files with 45 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2011-11-25 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/51250
PR fortran/43829
* trans-array.c (gfc_trans_create_temp_array): Get dimension from
the right gfc_ss struct.
2011-11-25 Tobias Burnus <burnus@net-b.de>
PR fortran/50408

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

@ -1087,7 +1087,7 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss,
for (s = ss; s; s = s->parent)
for (n = 0; n < s->loop->dimen; n++)
{
dim = get_scalarizer_dim_for_array_dim (ss, ss->dim[n]);
dim = get_scalarizer_dim_for_array_dim (ss, s->dim[n]);
/* For a callee allocated array express the loop bounds in terms
of the descriptor fields. */

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
2011-11-25 Mikael Morin <mikael@gcc.gnu.org>
PR fortran/51250
PR fortran/43829
* gfortran.dg/inline_sum_3.f90: New test.
2011-11-25 Uros Bizjak <ubizjak@gmail.com>
PR testsuite/51258

31
gcc/testsuite/gfortran.dg/inline_sum_3.f90 Normal file
View file

@ -0,0 +1,31 @@
! { dg-do run }
!
! PR fortran/51250
! Wrong loop shape for SUM when arguments are library-allocated arrays.
!
! Original testcase provided by Harald Anlauf <anlauf@gmx.de>
program gfcbug115
implicit none
integer :: n_obstype = 2
integer :: nboxes = 1
integer :: nprocs = 1
integer :: nbox, j
integer, allocatable :: nbx(:,:), pes(:)
allocate (pes(nboxes))
allocate (nbx(n_obstype,nboxes))
nbx(:,:) = 1
do j = 1, nboxes
pes(j) = modulo (j-1, nprocs)
end do
if (any(nbx /= 1)) call abort
do j = 0, nprocs-1
if (.not. all(spread (pes==j,dim=1,ncopies=n_obstype))) call abort
! The two following tests used to fail
if (any(shape(sum(nbx,dim=2,mask=spread (pes==j,dim=1,ncopies=n_obstype))) &
/= (/ 2 /))) call abort
if (any(sum (nbx,dim=2,mask=spread (pes==j,dim=1,ncopies=n_obstype)) &
/= (/ 1, 1 /))) call abort
end do
end program gfcbug115