2013-08-26 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/58146
	* array.c (gfc_ref_dimen_size):  If possible, use
	gfc_dep_difference to calculate array refrence
	sizes.  Fall back to integer code otherwise.
	* dependency.c (discard_nops).  Move up.
	Also discarde widening integer conversions.
	(gfc_dep_compare_expr):  Use discard_nops.

2013-08-26  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/58146
	* gfortran.dg/bounds_check_18.f90:  New test.



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

5 files changed, 122 insertions, 73 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e804749727d..7e8326b8ba5 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2013-08-26  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/58146
+	* array.c (gfc_ref_dimen_size):  If possible, use
+	gfc_dep_difference to calculate array refrence
+	sizes.  Fall back to integer code otherwise.
+	* dependency.c (discard_nops).  Move up.
+	Also discarde widening integer conversions.
+	(gfc_dep_compare_expr):  Use discard_nops.
+
 2013-08-23  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/57798
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index f07bc64dbca..687ae3d2f0d 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -2112,6 +2112,7 @@ bool
 gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
 {
   mpz_t upper, lower, stride;
+  mpz_t diff;
   bool t;
 
   if (dimen < 0 || ar == NULL || dimen > ar->dimen - 1)
@@ -2130,9 +2131,63 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
       break;
 
     case DIMEN_RANGE:
+
+      mpz_init (stride);
+
+      if (ar->stride[dimen] == NULL)
+	mpz_set_ui (stride, 1);
+      else
+	{
+	  if (ar->stride[dimen]->expr_type != EXPR_CONSTANT)
+	    {
+	      mpz_clear (stride);
+	      return false;
+	    }
+	  mpz_set (stride, ar->stride[dimen]->value.integer);
+	}
+
+      /* Calculate the number of elements via gfc_dep_differce, but only if
+	 start and end are both supplied in the reference or the array spec.
+	 This is to guard against strange but valid code like
+
+	 subroutine foo(a,n)
+	 real a(1:n)
+	 n = 3
+	 print *,size(a(n-1:))
+
+	 where the user changes the value of a variable.  If we have to
+	 determine end as well, we cannot do this using gfc_dep_difference.
+	 Fall back to the constants-only code then.  */
+
+      if (end == NULL)
+	{
+	  bool use_dep;
+
+	  use_dep = gfc_dep_difference (ar->end[dimen], ar->start[dimen],
+					&diff);
+	  if (!use_dep && ar->end[dimen] == NULL && ar->start[dimen] == NULL)
+	    use_dep = gfc_dep_difference (ar->as->upper[dimen],
+					    ar->as->lower[dimen], &diff);
+
+	  if (use_dep)
+	    {
+	      mpz_init (*result);
+	      mpz_add (*result, diff, stride);
+	      mpz_div (*result, *result, stride);
+	      if (mpz_cmp_ui (*result, 0) < 0)
+		mpz_set_ui (*result, 0);
+
+	      mpz_clear (stride);
+	      mpz_clear (diff);
+	      return true;
+	    }
+
+	}
+
+      /*  Constant-only code here, which covers more cases
+	  like a(:4) etc.  */
       mpz_init (upper);
       mpz_init (lower);
-      mpz_init (stride);
       t = false;
 
       if (ar->start[dimen] == NULL)
@@ -2163,15 +2218,6 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end)
 	  mpz_set (upper, ar->end[dimen]->value.integer);
 	}
 
-      if (ar->stride[dimen] == NULL)
-	mpz_set_ui (stride, 1);
-      else
-	{
-	  if (ar->stride[dimen]->expr_type != EXPR_CONSTANT)
-	    goto cleanup;
-	  mpz_set (stride, ar->stride[dimen]->value.integer);
-	}
-
       mpz_init (*result);
       mpz_sub (*result, upper, lower);
       mpz_add (*result, *result, stride);
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 350c7bd07a2..d85905cb6b8 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -240,6 +240,46 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
 	return -2;      
 }
 
+/* Helper function to look through parens, unary plus and widening
+   integer conversions.  */
+
+static gfc_expr*
+discard_nops (gfc_expr *e)
+{
+  gfc_actual_arglist *arglist;
+
+  if (e == NULL)
+    return NULL;
+
+  while (true)
+    {
+      if (e->expr_type == EXPR_OP
+	  && (e->value.op.op == INTRINSIC_UPLUS
+	      || e->value.op.op == INTRINSIC_PARENTHESES))
+	{
+	  e = e->value.op.op1;
+	  continue;
+	}
+
+      if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+	  && e->value.function.isym->id == GFC_ISYM_CONVERSION
+	  && e->ts.type == BT_INTEGER)
+	{
+	  arglist = e->value.function.actual;
+	  if (arglist->expr->ts.type == BT_INTEGER
+	      && e->ts.kind > arglist->expr->ts.kind)
+	    {
+	      e = arglist->expr;
+	      continue;
+	    }
+	}
+      break;
+    }
+
+  return e;
+}
+
+
 /* Compare two expressions.  Return values:
    * +1 if e1 > e2
    * 0 if e1 == e2
@@ -252,59 +292,13 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
 int
 gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 {
-  gfc_actual_arglist *args1;
-  gfc_actual_arglist *args2;
   int i;
-  gfc_expr *n1, *n2;
-
-  n1 = NULL;
-  n2 = NULL;
 
   if (e1 == NULL && e2 == NULL)
     return 0;
 
-  /* Remove any integer conversion functions to larger types.  */
-  if (e1->expr_type == EXPR_FUNCTION && e1->value.function.isym
-      && e1->value.function.isym->id == GFC_ISYM_CONVERSION
-      && e1->ts.type == BT_INTEGER)
-    {
-      args1 = e1->value.function.actual;
-      if (args1->expr->ts.type == BT_INTEGER
-	  && e1->ts.kind > args1->expr->ts.kind)
-	n1 = args1->expr;
-    }
-
-  if (e2->expr_type == EXPR_FUNCTION && e2->value.function.isym
-      && e2->value.function.isym->id == GFC_ISYM_CONVERSION
-      && e2->ts.type == BT_INTEGER)
-    {
-      args2 = e2->value.function.actual;
-      if (args2->expr->ts.type == BT_INTEGER
-	  && e2->ts.kind > args2->expr->ts.kind)
-	n2 = args2->expr;
-    }
-
-  if (n1 != NULL)
-    {
-      if (n2 != NULL)
-	return gfc_dep_compare_expr (n1, n2);
-      else
-	return gfc_dep_compare_expr (n1, e2);
-    }
-  else
-    {
-      if (n2 != NULL)
-	return gfc_dep_compare_expr (e1, n2);
-    }
-  
-  if (e1->expr_type == EXPR_OP
-      && (e1->value.op.op == INTRINSIC_UPLUS
-	  || e1->value.op.op == INTRINSIC_PARENTHESES))
-    return gfc_dep_compare_expr (e1->value.op.op1, e2);
-  if (e2->expr_type == EXPR_OP
-      && (e2->value.op.op == INTRINSIC_UPLUS
-	  || e2->value.op.op == INTRINSIC_PARENTHESES))
-    return gfc_dep_compare_expr (e1, e2->value.op.op1);
+  e1 = discard_nops (e1);
+  e2 = discard_nops (e2);
 
   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     {
@@ -501,21 +495,6 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
 }
 
 
-/* Helper function to look through parens and unary plus.  */
-
-static gfc_expr*
-discard_nops (gfc_expr *e)
-{
-
-  while (e && e->expr_type == EXPR_OP
-	 && (e->value.op.op == INTRINSIC_UPLUS
-	     || e->value.op.op == INTRINSIC_PARENTHESES))
-    e = e->value.op.op1;
-
-  return e;
-}
-
-
 /* Return the difference between two expressions.  Integer expressions of
    the form 
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 3468f327c54..1d1e2742c69 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2013-08-26  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/58146
+	* gfortran.dg/bounds_check_18.f90:  New test.
+
 2013-08-23  Jan Hubicka  <jh@suse.cz>
 
 	* g++.dg/ipa/devirt-14.C: Fix typo.
diff --git a/gcc/testsuite/gfortran.dg/bounds_check_18.f90 b/gcc/testsuite/gfortran.dg/bounds_check_18.f90
new file mode 100644
index 00000000000..afd0503ef10
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/bounds_check_18.f90
@@ -0,0 +1,9 @@
+! { dg-do compile }
+program main
+  implicit none
+  integer :: n
+  real, dimension(10) :: a
+  n = 0
+  call random_number(a)
+  if (any(a(n+1:n+5) > [1.0, 2.0, 3.0])) print *,"Hello!" ! { dg-error "not conformable" }
+end program main