This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[patch, Fortran] PR 58146, enable array slice compile-time bounds checking


Hello world,

the attached patch enables more sophisticated bounds-checking on
array slices by using gfc_dep_difference to calculate extents.
The information may also be useful in other places of the
front end, I don't really know.

There is one wrinkle (alluded to in the comments) which makes
this harder.  When somebody changes the value of a variable
used in detemining the size of an array, such as

subroutine foo(a,n)
  real, dimension(n) :: a

  n = n -2

  print *,ubound(a(n-1:))

we cannot compare n-1 against n and think that their difference is
one :-(

This is why I restricted myself to expressions where all
indices are specified, e.g. in a(n+1:n+4) or none are specified,
as in a(:).

In order for this to work on 64-bit systems, it was necessary
to look through widening integer conversions, so I added that
functionality to discard_nops.  Using this function in
gfc_dep_compare_expr made this function shorter and cleaner.

Regression-tested.  OK for trunk?

	Thomas

2013-08-14  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-14  Thomas Koenig  <tkoenig@gcc.gnu.org>

        PR fortran/58146
        * gfortran.dg/bounds_check_18.f90:  New test.
Index: array.c
===================================================================
--- array.c	(Revision 201648)
+++ array.c	(Arbeitskopie)
@@ -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,
       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_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);
Index: dependency.c
===================================================================
--- dependency.c	(Revision 201648)
+++ dependency.c	(Arbeitskopie)
@@ -240,6 +240,46 @@ gfc_dep_compare_functions (gfc_expr *e1, gfc_expr
 	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
@@ -255,57 +295,13 @@ 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;
-    }
+  e1 = discard_nops (e1);
+  e2 = discard_nops (e2);
 
-  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);
-
   if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
     {
       /* Compare X+C vs. X, for INTEGER only.  */
@@ -501,21 +497,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 
 
! { 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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]