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

trans-expr.c (gfc_caf_get_image_index): Fix image calculation.

Browse source 
gcc/fortran/
2014-11-22  Tobias Burnus  <burnus@net-b.de>

        * trans-expr.c (gfc_caf_get_image_index): Fix image calculation.

gcc/testsuite/
2014-11-22  Tobias Burnus  <burnus@net-b.de>

        * gfortran.dg/coarray/cosubscript_1.f90: New.

From-SVN: r217966
This commit is contained in:
Tobias Burnus 2014-11-22 15:14:35 +01:00 • committed by Tobias Burnus
parent 19f51f28fc
commit 5d26fda334
4 changed files with 85 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
gcc/fortran/ChangeLog
View file

@ -1,3 +1,7 @@
2014-11-22 Tobias Burnus <burnus@net-b.de>
* trans-expr.c (gfc_caf_get_image_index): Fix image calculation.
2014-11-15 Tobias Burnus <burnus@net-b.de>
* error.c (gfc_fatal_error_1): Renamed from gfc_fatal_error.

18
gcc/fortran/trans-expr.c
View file

@ -1518,8 +1518,8 @@ gfc_get_caf_token_offset (tree *token, tree *offset, tree caf_decl, tree se_expr
/* Convert the coindex of a coarray into an image index; the result is
image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2)+1)*extent(1)
+ (idx(3)-lcobound(3)+1)*extent(2) + ... */
image_num = (idx(1)-lcobound(1)+1) + (idx(2)-lcobound(2))*extent(1)
+ (idx(3)-lcobound(3))*extend(1)*extent(2) + ... */
tree
gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc)
@ -1553,8 +1553,10 @@ gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc)
if (i < ref->u.ar.dimen + ref->u.ar.codimen - 1)
{
ubound = gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[i]);
extent = gfc_conv_array_extent_dim (lbound, ubound, NULL);
extent = fold_convert (integer_type_node, extent);
tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
tmp = fold_convert (integer_type_node, tmp);
extent = fold_build2_loc (input_location, MULT_EXPR,
integer_type_node, extent, tmp);
}
}
else
@ -1575,10 +1577,12 @@ gfc_caf_get_image_index (stmtblock_t *block, gfc_expr *e, tree desc)
{
ubound = GFC_TYPE_ARRAY_UBOUND (TREE_TYPE (desc), i);
ubound = fold_convert (integer_type_node, ubound);
extent = fold_build2_loc (input_location, MINUS_EXPR,
tmp = fold_build2_loc (input_location, MINUS_EXPR,
integer_type_node, ubound, lbound);
extent = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
extent, integer_one_node);
tmp = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,
tmp, integer_one_node);
extent = fold_build2_loc (input_location, MULT_EXPR,
integer_type_node, extent, tmp);
}
}
img_idx = fold_build2_loc (input_location, PLUS_EXPR, integer_type_node,

4
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,7 @@
2014-11-22 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray/cosubscript_1.f90: New.
2014-11-22 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/pack11.ads: New test.

66
gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 Normal file
View file

@ -0,0 +1,66 @@
! { dg-do run }
!
! From the HPCTools Group of University of Houston
!
! For a coindexed object, its cosubscript list determines the image
! index in the same way that a subscript list determines the subscript
! order value for an array element
! Run at least with 3 images for the normal checking code
! Modified to also accept a single or two images
program cosubscript_test
implicit none
integer, parameter :: X = 3, Y = 2
integer, parameter :: P = 1, Q = -1
integer :: me
integer :: i,j,k
integer :: scalar[0:P, -1:Q, *]
integer :: dim3_max, counter
logical :: is_err
is_err = .false.
me = this_image()
scalar = me
dim3_max = num_images() / ( (P+1)*(Q+2) )
sync all
if (num_images() == 1) then
k = 1
j = -1
i = 0
if (scalar[i,j,k] /= this_image()) call abort
stop "OK"
else if (num_images() == 2) then
k = 1
j = -1
counter = 0
do i = 0,P
counter = counter+1
if (counter /= scalar[i,j,k]) call abort()
end do
stop "OK"
end if
! ******* SCALAR ***********
counter = 0
do k = 1, dim3_max
do j = -1,Q
do i = 0,P
counter = counter+1
if (counter /= scalar[i,j,k]) then
print * , "Error in cosubscript translation scalar"
print * , "[", i,",",j,",",k,"] = ",scalar[i,j,k],"/=",counter
is_err = .true.
end if
end do
end do
end do
if (is_err) then
call abort()
end if
end program cosubscript_test