re PR fortran/58009 (Elements with same value in vector subscript in variable definit...

2013-07-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/58009
	* expr.c (gfc_check_vardef_context):  Check for same values in
	vector expression subscripts.

2013-07-28  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/58009
	* gfortran.dg/vector_subsript_7.f90:  New test.

From-SVN: r201294

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 559e688206e5cc70854a1d44fd6fa4ab1bfcad92..8ec11b6e4531b0fe4190843fb41a9dc191197da9 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2013-07-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/58009
+       * expr.c (gfc_check_vardef_context):  Check for same values in
+       vector expression subscripts.
+
 2013-07-27  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57991

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 3ece2d3b70c07fc727808881a0d05e3265347721..c00fbc5493f0d4b1a75c52d0bf42df7a2697e9f1 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4700,6 +4700,7 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
   bool unlimited;
   symbol_attribute attr;
   gfc_ref* ref;
+  int i;
 
   if (e->expr_type == EXPR_VARIABLE)
     {
@@ -4922,5 +4923,49 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj,
        }
     }
 
+  /* Check for same value in vector expression subscript.  */
+
+  if (e->rank > 0)
+    for (ref = e->ref; ref != NULL; ref = ref->next)
+      if (ref->type == REF_ARRAY && ref->u.ar.type == AR_SECTION)
+       for (i = 0; i < GFC_MAX_DIMENSIONS
+              && ref->u.ar.dimen_type[i] != 0; i++)
+         if (ref->u.ar.dimen_type[i] == DIMEN_VECTOR)
+           {
+             gfc_expr *arr = ref->u.ar.start[i];
+             if (arr->expr_type == EXPR_ARRAY)
+               {
+                 gfc_constructor *c, *n;
+                 gfc_expr *ec, *en;
+                 
+                 for (c = gfc_constructor_first (arr->value.constructor);
+                      c != NULL; c = gfc_constructor_next (c))
+                   {
+                     if (c == NULL || c->iterator != NULL)
+                       continue;
+                     
+                     ec = c->expr;
+
+                     for (n = gfc_constructor_next (c); n != NULL;
+                          n = gfc_constructor_next (n))
+                       {
+                         if (n->iterator != NULL)
+                           continue;
+                         
+                         en = n->expr;
+                         if (gfc_dep_compare_expr (ec, en) == 0)
+                           {
+                             gfc_error_now ("Elements with the same value at %L"
+                                            " and %L in vector subscript"
+                                            " in a variable definition"
+                                            " context (%s)", &(ec->where),
+                                            &(en->where), context);
+                             return false;
+                           }
+                       }
+                   }
+               }
+           }
+  
   return true;
 }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fe05cb85690155f6a103eee29e011ebd8cb34b6d..38fcfefd6301cc54de0ed63755bff51bcb35f426 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-07-28  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/58009
+       * gfortran.dg/vector_subsript_7.f90:  New test.
+
 2013-07-27  Tobias Burnus  <burnus@net-b.de>
 
        PR fortran/57991

diff --git a/gcc/testsuite/gfortran.dg/vector_subscript_7.f90 b/gcc/testsuite/gfortran.dg/vector_subscript_7.f90
new file mode 100644 (file)
index 0000000..ddc8139
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/vector_subscript_7.f90
@@ -0,0 +1,21 @@
+! { dg-do compile }
+! PR 58009 - If a vector subscript has two or more elements with the
+! same value, an array section with that vector subscript
+! shall not appear in a variable definition context.
+
+program main
+  real, dimension(4) :: a,b
+  real, dimension(1,4) :: c
+  read (*,*) a([1,2,3,2]),i ! { dg-error "Elements with the same value" }
+  read (*,*) c(1,[1,2,3,2]),i ! { dg-error "Elements with the same value" }
+  b([1+i,1,i+1,2]) = a      ! { dg-error "Elements with the same value" }
+  c(1,[1+i,1,i+1,2]) = a    ! { dg-error "Elements with the same value" }
+  call foo (a([4,2,1,1]))   ! { dg-error "Elements with the same value" }
+  call foo (c(1,[4,2,1,1])) ! { dg-error "Elements with the same value" }
+  print *,a,b
+contains
+  subroutine foo(arg)
+    real, intent(inout) :: arg(:)
+    arg = arg + 1
+  end subroutine foo 
+end program main