re PR fortran/29892 (substring out of bounds: Missing variable name for variables...

	PR fortran/29892
	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use a locus in
	the call to gfc_trans_runtime_check.
	* trans-array.c (gfc_trans_array_bound_check): Try harder to find
	the variable or function name for the runtime error message.
	(gfc_trans_dummy_array_bias): Use a locus in the call to
	gfc_trans_runtime_check

From-SVN: r119223

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 9b350ff334727528296c4477ba9f710bd87d047d..4c8a2ecda68294ce0e395122a73db7991a2287b8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2006-11-26  Francois-Xavier Coudert  <coudert@clipper.ens.fr>
+
+       PR fortran/29892
+       * trans-intrinsic.c (gfc_conv_intrinsic_bound): Use a locus in
+       the call to gfc_trans_runtime_check.
+       * trans-array.c (gfc_trans_array_bound_check): Try harder to find
+       the variable or function name for the runtime error message.
+       (gfc_trans_dummy_array_bias): Use a locus in the call to
+       gfc_trans_runtime_check
+
 2006-11-26  Andrew Pinski  <pinskia@gmail.com>
 
        * trans-decl.c (gfc_build_intrinsic_function_decls): Mark the

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index 2a5b3b72e1398d907fb3eaf743c8977b69b933fa..991fa1c18ea916c5b39c61f706012cf3f150a2f9 100644 (file)
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1849,18 +1849,47 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
   tree fault;
   tree tmp;
   char *msg;
+  const char * name = NULL;
 
   if (!flag_bounds_check)
     return index;
 
   index = gfc_evaluate_now (index, &se->pre);
 
+  /* We find a name for the error message.  */
+  if (se->ss)
+    name = se->ss->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->expr
+      && se->loop->ss->expr->symtree)
+    name = se->loop->ss->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain
+      && se->loop->ss->loop_chain->expr
+      && se->loop->ss->loop_chain->expr->symtree)
+    name = se->loop->ss->loop_chain->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->loop_chain
+      && se->loop->ss->loop_chain->expr->symtree)
+    name = se->loop->ss->loop_chain->expr->symtree->name;
+
+  if (!name && se->loop && se->loop->ss && se->loop->ss->expr)
+    {
+      if (se->loop->ss->expr->expr_type == EXPR_FUNCTION
+         && se->loop->ss->expr->value.function.name)
+       name = se->loop->ss->expr->value.function.name;
+      else
+       if (se->loop->ss->type == GFC_SS_CONSTRUCTOR
+           || se->loop->ss->type == GFC_SS_SCALAR)
+         name = "unnamed constant";
+    }
+
   /* Check lower bound.  */
   tmp = gfc_conv_array_lbound (descriptor, n);
   fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp);
-  if (se->ss)
+  if (name)
     asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded",
-             gfc_msg_fault, se->ss->expr->symtree->name, n+1);
+             gfc_msg_fault, name, n+1);
   else
     asprintf (&msg, "%s, lower bound of dimension %d exceeded",
              gfc_msg_fault, n+1);
@@ -1870,9 +1899,9 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
   /* Check upper bound.  */
   tmp = gfc_conv_array_ubound (descriptor, n);
   fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
-  if (se->ss)
+  if (name)
     asprintf (&msg, "%s for array '%s', upper bound of dimension %d exceeded",
-             gfc_msg_fault, se->ss->expr->symtree->name, n+1);
+             gfc_msg_fault, name, n+1);
   else
     asprintf (&msg, "%s, upper bound of dimension %d exceeded",
              gfc_msg_fault, n+1);
@@ -3904,7 +3933,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
               tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2);
              asprintf (&msg, "%s for dimension %d of array '%s'",
                        gfc_msg_bounds, n+1, sym->name);
-             gfc_trans_runtime_check (tmp, msg, &block, NULL);
+             gfc_trans_runtime_check (tmp, msg, &block, &loc);
              gfc_free (msg);
            }
        }

diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 9256e86776e23ee50e7c616fb65f9527ca90e62b..d284931bca557bfb65afc3d1ca88ad1390aa1625 100644 (file)
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -779,7 +779,7 @@ gfc_conv_intrinsic_bound (gfc_se * se, gfc_expr * expr, int upper)
           tmp = gfc_rank_cst[GFC_TYPE_ARRAY_RANK (TREE_TYPE (desc))];
           tmp = fold_build2 (GE_EXPR, boolean_type_node, bound, tmp);
           cond = fold_build2 (TRUTH_ORIF_EXPR, boolean_type_node, cond, tmp);
-          gfc_trans_runtime_check (cond, gfc_msg_fault, &se->pre, NULL);
+          gfc_trans_runtime_check (cond, gfc_msg_fault, &se->pre, &expr->where);
         }
     }