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

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

gcc/fortran/ChangeLog

+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.

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,

gcc/testsuite/ChangeLog

+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.

gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90

+! { 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