Hello world,

this patch yields an error for identical values in vector expression
subscripts.  The algorithm is O(n**2) because

a) It would be impossible to detect a([i,i]) otherwise
b) This is not likely to be a performance bottleneck because
   people don't use large vector indices.

(as noted by the different comments in the PR).

Regression-tested.  OK for trunk?

        Thomas

2013-07-28  Thomas Koenig  <tkoe...@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  <tkoe...@gcc.gnu.org>

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

Index: expr.c
===================================================================
--- expr.c	(Revision 200743)
+++ expr.c	(Arbeitskopie)
@@ -4700,6 +4700,8 @@ gfc_check_vardef_context (gfc_expr* e, bool pointe
   bool unlimited;
   symbol_attribute attr;
   gfc_ref* ref;
+  bool retval;
+  int i;
 
   if (e->expr_type == EXPR_VARIABLE)
     {
@@ -4922,5 +4924,54 @@ gfc_check_vardef_context (gfc_expr* e, bool pointe
 	}
     }
 
-  return true;
+  /* Check for same value in vector expression subscript.  */
+  retval = true;
+
+  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<e->rank; 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);
+			      retval = false;
+
+			      /* Do not issue O(n**2) errors for n occurrences
+				 of the same value. */
+			      break;
+
+			      }
+			  }
+		    }
+		}
+	    }
+  
+  return retval;
 }
! { 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
  read (*,*) a([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" }
  call foo (a([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

Reply via email to