From 5d26fda334585316dcc494aa001e8596c0569d2f Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Sat, 22 Nov 2014 15:14:35 +0100 Subject: [PATCH] trans-expr.c (gfc_caf_get_image_index): Fix image calculation. gcc/fortran/ 2014-11-22 Tobias Burnus * trans-expr.c (gfc_caf_get_image_index): Fix image calculation. gcc/testsuite/ 2014-11-22 Tobias Burnus * gfortran.dg/coarray/cosubscript_1.f90: New. From-SVN: r217966 --- gcc/fortran/ChangeLog | 4 ++ gcc/fortran/trans-expr.c | 18 +++-- gcc/testsuite/ChangeLog | 4 ++ .../gfortran.dg/coarray/cosubscript_1.f90 | 66 +++++++++++++++++++ 4 files changed, 85 insertions(+), 7 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index b8cf60128b7..db650e3f90c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2014-11-22 Tobias Burnus + + * trans-expr.c (gfc_caf_get_image_index): Fix image calculation. + 2014-11-15 Tobias Burnus * error.c (gfc_fatal_error_1): Renamed from gfc_fatal_error. diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b36acbe1ea2..af7e8cf3c8c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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, diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5d5706b0b5c..e30e0ff5e14 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2014-11-22 Tobias Burnus + + * gfortran.dg/coarray/cosubscript_1.f90: New. + 2014-11-22 Eric Botcazou * gnat.dg/specs/pack11.ads: New test. diff --git a/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 b/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 new file mode 100644 index 00000000000..20ee454450f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 @@ -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 -- 2.30.2