re PR fortran/18918 (Eventually support Fortran 2008's coarrays [co-arrays])

2011-04-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * array.c (gfc_match_array_ref): Check for too many
        * codimensions.
        * check.c (gfc_check_image_index): Check number of elements
        in SUB argument.
        * simplify.c (gfc_simplify_image_index): Remove unreachable
        * checks.

2011-04-18  Tobias Burnus  <burnus@net-b.de>

        PR fortran/18918
        * gfortran.dg/coarray_17.f90: New.
        * gfortran.dg/coarray_10.f90: Update dg-error.

From-SVN: r172658

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7154e621211934448df10c7f5c3f5a7efc621d52..a55e1c0d3d2a45143c31f39224436b04cb78a13a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2011-04-18  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/18918
+       * array.c (gfc_match_array_ref): Check for too many codimensions.
+       * check.c (gfc_check_image_index): Check number of elements
+       in SUB argument.
+       * simplify.c (gfc_simplify_image_index): Remove unreachable checks.
+
 2011-04-18  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/18918

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index ff0977a5dfec80ed39713e129b8a575304bfc3b6..750d73315f2d7194ddc355451d28295f40512b06 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -237,6 +237,12 @@ coarray:
                         corank, ar->codimen);
              return MATCH_ERROR;
            }
+         if (ar->codimen > corank)
+           {
+             gfc_error ("Too many codimensions at %C, expected %d not %d",
+                        corank, ar->codimen);
+             return MATCH_ERROR;
+           }
          return MATCH_YES;
        }
 

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index bb56122137e44f0f042def053be36cb16b601606..864114206731c2cc99fba1240eaf0b3c734504d8 100644 (file)
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -3667,6 +3667,8 @@ gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status)
 gfc_try
 gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
 {
+  mpz_t nelems;
+
   if (gfc_option.coarray == GFC_FCOARRAY_NONE)
     {
       gfc_fatal_error ("Coarrays disabled at %C, use -fcoarray= to enable");
@@ -3683,6 +3685,21 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub)
       return FAILURE;
     }
 
+  if (gfc_array_size (sub, &nelems) == SUCCESS)
+    {
+      int corank = gfc_get_corank (coarray);
+
+      if (mpz_cmp_ui (nelems, corank) != 0)
+       {
+         gfc_error ("The number of array elements of the SUB argument to "
+                    "IMAGE_INDEX at %L shall be %d (corank) not %d",
+                    &sub->where, corank, (int) mpz_get_si (nelems));
+         mpz_clear (nelems);
+         return FAILURE;
+       }
+      mpz_clear (nelems);
+    }
+
   return SUCCESS;
 }
 

diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c
index b744a214ed538ceff0ec12981272923f6bbc64db..784f27fc7931c0ea795fa839c5d2fe361262dfe1 100644 (file)
--- a/gcc/fortran/simplify.c
+++ b/gcc/fortran/simplify.c
@@ -6211,12 +6211,7 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
       gfc_expr *ca_bound;
       int cmp;
 
-      if (sub_cons == NULL)
-       {
-         gfc_error ("Too few elements in expression for SUB= argument at %L",
-                    &sub->where);
-         return &gfc_bad_expr;
-       }
+      gcc_assert (sub_cons != NULL);
 
       ca_bound = simplify_bound_dim (coarray, NULL, d + as->rank, 0, as,
                                     NULL, true);
@@ -6278,13 +6273,7 @@ gfc_simplify_image_index (gfc_expr *coarray, gfc_expr *sub)
       sub_cons = gfc_constructor_next (sub_cons);
     }
 
-  if (sub_cons != NULL)
-    {
-      gfc_error ("Too many elements in expression for SUB= argument at %L",
-                &sub->where);
-      return &gfc_bad_expr;
-    }
-
+  gcc_assert (sub_cons == NULL);
 
   if (gfc_option.coarray != GFC_FCOARRAY_SINGLE && !first_image)
     return NULL;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7014a0cdbc0efccb03d3dd21c1bdf5ec7eba3e74..58bf81ac2a890f07de26412dc7628882f5a8deb6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2011-04-18  Tobias Burnus  <burnus@net-b.de>
+
+       PR fortran/18918
+       * gfortran.dg/coarray_17.f90: New.
+       * gfortran.dg/coarray_10.f90: Update dg-error.
+
 2011-04-18  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
        PR testsuite/48251

diff --git a/gcc/testsuite/gfortran.dg/coarray_10.f90 b/gcc/testsuite/gfortran.dg/coarray_10.f90
index d32e25478c774c98f4237b7568a449ce0b769dd8..99f5782e35b2a81ecd279cd3ddbb94be8f1ae9b2 100644 (file)
--- a/gcc/testsuite/gfortran.dg/coarray_10.f90
+++ b/gcc/testsuite/gfortran.dg/coarray_10.f90
@@ -11,8 +11,8 @@ subroutine image_idx_test1()
   WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1])
   WRITE (*,*) IMAGE_INDEX (array, [0,0,3,1])  ! { dg-error "for dimension 1, SUB has 0 and COARRAY lower bound is 1" }
   WRITE (*,*) IMAGE_INDEX (array, [1,2,9,0])  ! { dg-error "for dimension 3, SUB has 9 and COARRAY upper bound is 8" }
-  WRITE (*,*) IMAGE_INDEX (array, [2,0,3])    ! { dg-error "Too few elements" }
-  WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1,1])! { dg-error "Too many elements" }
+  WRITE (*,*) IMAGE_INDEX (array, [2,0,3])    ! { dg-error "array elements of the SUB argument to IMAGE_INDEX at .1. shall be 4" }
+  WRITE (*,*) IMAGE_INDEX (array, [2,0,3,1,1])! { dg-error "array elements of the SUB argument to IMAGE_INDEX at .1. shall be 4" }
 end subroutine
 
 subroutine this_image_check()

diff --git a/gcc/testsuite/gfortran.dg/coarray_17.f90 b/gcc/testsuite/gfortran.dg/coarray_17.f90
new file mode 100644 (file)
index 0000000..ad6da29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray_17.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! { dg-options "-fcoarray=single" }
+!
+! Two simple diagnostics, which were initially not thought of
+!
+! General coarray PR: PR fortran/18918
+! 
+
+subroutine one
+    integer, allocatable :: a(:)[:,:]  ! corank = 2
+    integer :: index,nn1,nn2,nn3,mm0
+
+    allocate(a(mm0)[nn1:nn2,nn3,*]) ! { dg-error "Too many codimensions at .1., expected 2 not 3" }
+end subroutine one
+
+subroutine two
+    integer, allocatable :: a(:)[:,:,:], b(:)[:,:], c(:)[:]
+    index1 = image_index(a, [2, 1, 1] )  !OK
+    index2 = image_index(b, [2, 1, 1] )  ! { dg-error "array elements of the SUB argument to IMAGE_INDEX at .1. shall be 2 .corank. not 3" }
+    index3 = image_index(c, [1] )        !OK
+end subroutine two