diff mbox

[Fortran,committed] Re: Cosubscript issue

Message ID 54709A5D.5070604@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Nov. 22, 2014, 2:14 p.m. UTC 
On 19 November 2014 at 23:20, Tobias Burnus wrote:
> 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.

Took a while longer as it turned out that the test case didn't work for 
odd number of images. As testing showed, other compilers behave the same 
and codewise, I didn't understand:

+  if (MOD(num_images(),((P+1)*(Q+2))) .ge. 1) then
+     dim3_max = dim3_max+1
+  end if


And indeed, removing that code from the test case, it worked – and also the test program makes sense to me.

Hence, I have now committed the patch together with the fixed test case as Rev. 217966.

Tobias
diff mbox

Patch

Index: gcc/fortran/ChangeLog
===================================================================
--- gcc/fortran/ChangeLog	(Revision 217965)
+++ gcc/fortran/ChangeLog	(Arbeitskopie)
@@ -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.
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(Revision 217965)
+++ gcc/fortran/trans-expr.c	(Arbeitskopie)
@@ -1518,8 +1518,8 @@  gfc_get_caf_token_offset (tree *token, tree *offse
 
 
 /* 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_e
 	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_e
 	  {
 	    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,
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog	(Revision 217965)
+++ gcc/testsuite/ChangeLog	(Arbeitskopie)
@@ -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.
Index: gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90	(Arbeitskopie)
@@ -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