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

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

[Thomas Koenig]

[-- Attachment #1: Type: text/plain, Size: 1510 bytes --]

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.

[-- Attachment #2: p5.diff --]
[-- Type: text/x-patch, Size: 5902 bytes --]

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 
 

[-- Attachment #3: bounds_check_18.f90 --]
[-- Type: text/x-fortran, Size: 231 bytes --]

! { 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

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

[Mikael Morin]

Le 14/08/2013 23:46, Thomas Koenig a écrit :
> 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?
> 
This looks mostly good.  The dependency.c cleanup is nice, I have yet to
understand what the 'end == NULL' condition is for.  I come back to you
soon.

Mikael

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

[Mikael Morin]

Le 22/08/2013 23:30, Mikael Morin a écrit :
> Le 14/08/2013 23:46, Thomas Koenig a écrit :
>> 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?

OK.
By the way, it seems that arg1 and arg2 declarations should be removed
in gfc_dep_compare_expr.

>>
> This looks mostly good.  The dependency.c cleanup is nice, I have yet to
> understand what the 'end == NULL' condition is for.  I come back to you
> soon.
> 
For what it's worth, 'end' is non-NULL in only one place and there the
gfc_ref_dimen_size result is discarded.  Thus its handling should better
be inlined or have its own function separate from gfc_ref_dimen_size.
It seems to be a lot of trouble for little gain though.

Mikael

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

[Dominique Dhumieres]

Thomas,

The two lines

   gfc_actual_arglist *args1;
   gfc_actual_arglist *args2;

in gfc_dep_compare_expr must be removed. Otherwise
the compilation aborts with

.../../work/gcc/fortran/dependency.c: In function 'int gfc_dep_compare_expr(gfc_expr*, gfc_expr*)':
../../work/gcc/fortran/dependency.c:295:23: error: unused variable 'args1' [-Werror=unused-variable]
   gfc_actual_arglist *args1;
                       ^
../../work/gcc/fortran/dependency.c:296:23: error: unused variable 'args2' [-Werror=unused-variable]
   gfc_actual_arglist *args2;
                       ^

TIA

Dominique