2012-01-02 Tobias Burnus <burnus@net-b.de>

        PR fortran/51682
        * trans-intrinsic.c (trans_this_image, trans_image_index,
        trans_num_images, conv_intrinsic_cobound): Fold_convert the
        caf_num_images/caf_this_images variables to the correct int kind.

2012-01-02  Tobias Burnus  <burnus@net-b.de>

        PR fortran/51682
        * gfortran.dg/coarray/image_index_3.f90: New.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182781 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index a17aa4d..af5fd93 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2012-01-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/51682
+       * trans-intrinsic.c (trans_this_image, trans_image_index,
+       trans_num_images, conv_intrinsic_cobound): Fold_convert the
+       caf_num_images/caf_this_images variables to the correct int kind.
+
 2012-01-01  Jakub Jelinek  <jakub@redhat.com>
 
        * gfortranspec.c (lang_specific_driver): Update copyright notice

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 5c964c1..2bc628d 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -978,7 +978,8 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   /* Argument-free version: THIS_IMAGE().  */
   if (expr->value.function.actual->expr == NULL)
     {
-      se->expr = gfort_gvar_caf_this_image;
+      se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
+                              gfort_gvar_caf_this_image);
       return;
     }
 
@@ -1053,7 +1054,7 @@ trans_this_image (gfc_se * se, gfc_expr *expr)
   /* Used algorithm; cf. Fortran 2008, C.10. Note, due to the scalarizer,
      one always has a dim_arg argument.
 
-     m = this_images() - 1
+     m = this_image() - 1
      if (corank == 1)
        {
         sub(1) = m + lcobound(corank)
@@ -1289,7 +1290,7 @@ trans_image_index (gfc_se * se, gfc_expr *expr)
   else
     {
       gfc_init_coarray_decl (false);
-      num_images = gfort_gvar_caf_num_images;
+      num_images = fold_convert (type, gfort_gvar_caf_num_images);
     }
 
   tmp = gfc_create_var (type, NULL);
@@ -1309,7 +1310,8 @@ static void
 trans_num_images (gfc_se * se)
 {
   gfc_init_coarray_decl (false);
-  se->expr = gfort_gvar_caf_num_images;
+  se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind),
+                          gfort_gvar_caf_num_images);
 }
 
 
@@ -1614,7 +1616,8 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
 
          tmp = fold_build2_loc (input_location, MINUS_EXPR,
                                 gfc_array_index_type,
-                                gfort_gvar_caf_num_images,
+                                fold_convert (gfc_array_index_type,
+                                              gfort_gvar_caf_num_images),
                                 build_int_cst (gfc_array_index_type, 1));
          tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
                                 gfc_array_index_type, tmp,
@@ -1628,7 +1631,8 @@ conv_intrinsic_cobound (gfc_se * se, gfc_expr * expr)
          gfc_init_coarray_decl (false);
          tmp = fold_build2_loc (input_location, MINUS_EXPR,
                                 gfc_array_index_type,
-                                gfort_gvar_caf_num_images,
+                                fold_convert (gfc_array_index_type,
+                                              gfort_gvar_caf_num_images),
                                 build_int_cst (gfc_array_index_type, 1));
          resbound = fold_build2_loc (input_location, PLUS_EXPR,
                                      gfc_array_index_type, resbound, tmp);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3e35722..d8bcb9a 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-01-02  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/51682
+       * gfortran.dg/coarray/image_index_3.f90: New.
+
 2012-01-01  Paolo Carlini  <paolo.carlini@oracle.com>
 
        PR c++/16603

diff --git a/gcc/testsuite/gfortran.dg/coarray/image_index_3.f90 b/gcc/testsuite/gfortran.dg/coarray/image_index_3.f90
new file mode 100644 (file)
index 0000000..9bfa02d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/image_index_3.f90
@@ -0,0 +1,103 @@
+! { dg-do run }
+! { dg-options "-fdefault-integer-8" }
+!
+! As image_index_1.f90 but with -fdefault-integer-8
+! PR fortran/51682
+!
+! Run-time test for IMAGE_INDEX with cobounds only known at
+! the compile time, suitable for any number of NUM_IMAGES()
+! For compile-time cobounds, the -fcoarray=lib version still
+! needs to run-time evalulation if image_index returns > 1
+! as image_index is 0 if the index would exceed num_images().
+!
+! Please set num_images() to >= 13, if possible.
+!
+! PR fortran/18918
+!
+
+program test_image_index
+implicit none
+integer :: index1, index2, index3
+logical :: one
+
+integer, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:,:)[:]
+integer, save :: d(2)[-1:3, *]
+integer, save :: e(2)[-1:-1, 3:*]
+
+one = num_images() == 1
+
+allocate(a(1)[3:3, -4:-3, 88:*])
+allocate(b(2)[-1:0,0:*])
+allocate(c(3,3)[*])
+
+index1 = image_index(a, [3, -4, 88] )
+index2 = image_index(b, [-1, 0] )
+index3 = image_index(c, [1] )
+if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
+
+
+index1 = image_index(a, [3, -3, 88] )
+index2 = image_index(b, [0, 0] )
+index3 = image_index(c, [2] )
+
+if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
+  call abort()
+if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
+  call abort()
+
+
+index1 = image_index(d, [-1, 1] )
+index2 = image_index(d, [0, 1] )
+
+if (one .and. (index1 /= 1 .or. index2 /= 0)) &
+  call abort()
+if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
+  call abort()
+
+index1 = image_index(e, [-1, 3] )
+index2 = image_index(e, [-1, 4] )
+
+if (one .and. (index1 /= 1 .or. index2 /= 0)) &
+  call abort()
+if (.not. one .and. (index1 /= 1 .or. index2 /= 2)) &
+  call abort()
+
+call test(1, a,b,c)
+
+! The following test is in honour of the F2008 standard:
+deallocate(a)
+allocate(a (10) [10, 0:9, 0:*])
+
+index1 = image_index(a, [1, 0, 0] )
+index2 = image_index(a, [3, 1, 2] )  ! = 213, yeah!
+index3 = image_index(a, [3, 1, 0] )  ! = 13
+
+if (num_images() < 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 0)) &
+  call abort()
+if (num_images() >= 213 .and. (index1 /= 1 .or. index2 /= 213 .or. index3 /= 13)) &
+  call abort()
+if (num_images() >= 13 .and. (index1 /= 1 .or. index2 /= 0 .or. index3 /= 13)) &
+  call abort()
+
+
+contains
+subroutine test(n, a, b, c)
+  integer :: n
+  integer :: a(1)[3*n:3*n, -4*n:-3*n, 88*n:*], b(2)[-1*n:0*n,0*n:*], c(3*n,3*n)[*]
+
+  index1 = image_index(a, [3, -4, 88] )
+  index2 = image_index(b, [-1, 0] )
+  index3 = image_index(c, [1] )
+  if (index1 /= 1 .or. index2 /= 1 .or. index3 /= 1) call abort()
+
+
+  index1 = image_index(a, [3, -3, 88] )
+  index2 = image_index(b, [0, 0] )
+  index3 = image_index(c, [2] )
+
+  if (one .and. (index1 /= 0 .or. index2 /= 0 .or. index3 /= 0)) &
+    call abort()
+  if (.not. one .and. (index1 /= 2 .or. index2 /= 2 .or. index3 /= 2)) &
+    call abort()
+end subroutine test
+end program test_image_index