re PR fortran/58009 (Elements with same value in vector subscript in variable definition context)

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

4 files changed, 77 insertions, 0 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 559e688..8ec11b6 100644
--- 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 3ece2d3..c00fbc5 100644
--- 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 fe05cb8..38fcfef 100644
--- 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
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