Re: Cosubscript issue

[Tobias Burnus <burnus at net-b dot de>]

Alessandro Fanfarillo wrote:
> The sum of the three indexes, k, j and i returns a wrong image index.

Fixed as confirmed off list by the attached patch.

I intent to commit it as obvious once building and regtesting has 
finally finished.
Comments are nontheless welcome.

Tobias

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

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

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b36acbe..4fdab30 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/gfortran.dg/coarray/cosubscript_1.f90 b/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90
new file mode 100644
index 0000000..e5a6e8c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90
@@ -0,0 +1,74 @@
+! { 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) )
+  
+  if (MOD(num_images(),((P+1)*(Q+2))) .ge. 1) then
+     dim3_max = dim3_max+1
+  end if
+  
+  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