Patchwork [Fortran] PR57721 - improve out-of-bounds error message for components

login
register
mail settings
Submitter Tobias Burnus
Date June 26, 2013, 1:14 p.m.
Message ID <51CAE919.4000800@net-b.de>
Download mbox | patch
Permalink /patch/254737/
State New
Headers show

Comments

Tobias Burnus - June 26, 2013, 1:14 p.m.
The patch changes the out-of-bounds message for "k==11"
   z(i)%y(j)%x(k)=0
from:
   Fortran runtime error: Index '11' of dimension 1 of array 'z' above 
upper bound of 10
to
   Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' 
above upper bound of 10

(For j out of bounds, it would show "z%y" and for i out of bounds "z".)

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
Thomas Koenig - June 26, 2013, 3:31 p.m.
Hi Tobias,

> The patch changes the out-of-bounds message for "k==11"
>    z(i)%y(j)%x(k)=0
> from:
>    Fortran runtime error: Index '11' of dimension 1 of array 'z' above
> upper bound of 10
> to
>    Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x'
> above upper bound of 10
>
> (For j out of bounds, it would show "z%y" and for i out of bounds "z".)
>
> Build and regtested on x86-64-gnu-linux.
> OK for the trunk?

OK.

Thanks a lot for the patch!

	Thomas

Patch

2013-06-26  Tobias Burnus  <burnus@net-b.de>

	PR fortran/29800
	* trans-array.c (gfc_conv_array_ref): Improve out-of-bounds
	diagnostic message.
	* trans-array.c (gfc_conv_array_ref): Update prototype.
	* trans-expr.c (gfc_conv_variable): Update call.

2013-06-26  Tobias Burnus  <burnus@net-b.de>

	PR fortran/29800
	* gfortran.dg/bounds_check_17.f90: New.

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 96162e5..d118f75 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -3145,7 +3145,7 @@  build_array_ref (tree desc, tree offset, tree decl)
    a(i, j, k) = base[offset + i * stride[0] + j * stride[1] + k * stride[2]]*/
 
 void
-gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
+gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_expr *expr,
 		    locus * where)
 {
   int n;
@@ -3154,6 +3154,8 @@  gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
   tree stride;
   gfc_se indexse;
   gfc_se tmpse;
+  gfc_symbol * sym = expr->symtree->n.sym;
+  char *var_name = NULL;
 
   if (ar->dimen == 0)
     {
@@ -3184,6 +3186,35 @@  gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
       return;
     }
 
+  if (gfc_option.rtcheck & GFC_RTCHECK_BOUNDS)
+    {
+      size_t len;
+      gfc_ref *ref;
+
+      len = strlen (sym->name) + 1;
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_ARRAY && &ref->u.ar == ar)
+	    break;
+	  if (ref->type == REF_COMPONENT)
+	    len += 1 + strlen (ref->u.c.component->name);
+	}
+
+      var_name = XALLOCAVEC (char, len);
+      strcpy (var_name, sym->name);
+
+      for (ref = expr->ref; ref; ref = ref->next)
+	{
+	  if (ref->type == REF_ARRAY && &ref->u.ar == ar)
+	    break;
+	  if (ref->type == REF_COMPONENT)
+	    {
+	      strcat (var_name, "%%");
+	      strcat (var_name, ref->u.c.component->name);
+	    }
+	}
+    }
+
   cst_offset = offset = gfc_index_zero_node;
   add_to_offset (&cst_offset, &offset, gfc_conv_array_offset (se->expr));
 
@@ -3219,7 +3250,7 @@  gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
 	  cond = fold_build2_loc (input_location, LT_EXPR, boolean_type_node,
 				  indexse.expr, tmp);
 	  asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
-		    "below lower bound of %%ld", n+1, sym->name);
+		    "below lower bound of %%ld", n+1, var_name);
 	  gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
 				   fold_convert (long_integer_type_node,
 						 indexse.expr),
@@ -3243,7 +3274,7 @@  gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
 	      cond = fold_build2_loc (input_location, GT_EXPR,
 				      boolean_type_node, indexse.expr, tmp);
 	      asprintf (&msg, "Index '%%ld' of dimension %d of array '%s' "
-			"above upper bound of %%ld", n+1, sym->name);
+			"above upper bound of %%ld", n+1, var_name);
 	      gfc_trans_runtime_check (true, false, cond, &se->pre, where, msg,
 				   fold_convert (long_integer_type_node,
 						 indexse.expr),
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 8d9e461..878a5c0 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -123,7 +123,7 @@  void gfc_conv_resolve_dependencies (gfc_loopinfo *, gfc_ss *, gfc_ss *);
 tree gfc_build_null_descriptor (tree);
 
 /* Get a single array element.  */
-void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_symbol *, locus *);
+void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
 /* Translate a reference to a temporary array.  */
 void gfc_conv_tmp_array_ref (gfc_se * se);
 /* Translate a reference to an array temporary.  */
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 56dc766..7a726db 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1910,7 +1910,7 @@  gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 	      && ref->next == NULL && (se->descriptor_only))
 	    return;
 
-	  gfc_conv_array_ref (se, &ref->u.ar, sym, &expr->where);
+	  gfc_conv_array_ref (se, &ref->u.ar, expr, &expr->where);
 	  /* Return a pointer to an element.  */
 	  break;
 
--- /dev/null	2013-06-26 08:23:53.976189029 +0200
+++ gcc/gcc/testsuite/gfortran.dg/bounds_check_17.f90	2013-06-26 15:10:24.528309201 +0200
@@ -0,0 +1,26 @@ 
+! { dg-do run }
+! { dg-options "-fcheck=bounds" }
+! { dg-shouldfail "above upper bound" }
+!
+! PR fortran/29800
+!
+! Contributed by Joost VandeVondele
+!
+
+TYPE data
+  INTEGER :: x(10)
+END TYPE
+TYPE data_areas
+  TYPE(data) :: y(10)
+END TYPE
+
+TYPE(data_areas) :: z(10)
+
+integer, volatile :: i,j,k
+i=1 ; j=1 ; k=11
+
+z(i)%y(j)%x(k)=0
+
+END
+
+! { dg-output "At line 22 of file .*bounds_check_17.f90.*Fortran runtime error: Index '11' of dimension 1 of array 'z%y%x' above upper bound of 10" }