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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index b8cf60128b74caaa9d5d8f4f8fb9aac407bdb408..db650e3f90c3c78fb43ce87f186b097bd0b3d607 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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.

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b36acbe1ea22d5b24269607785ea47ad07b894bf..af7e8cf3c8c0b139b3408b7f411c0d3142139964 100644 (file)
--- 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 5d5706b0b5c6bc38f4610206d29fbc44bd933a00..e30e0ff5e14910afd35a73ba4298ead109197350 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90 b/gcc/testsuite/gfortran.dg/coarray/cosubscript_1.f90
new file mode 100644 (file)
index 0000000..20ee454
--- /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