trans.c (gfc_msg_bounds, [...]): Add strings for common runtime error messages.

	* trans.c (gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return):
	Add strings for common runtime error messages.
	(gfc_trans_runtime_check): Add a locus argument, use a string
	and not a string tree for the message.
	* trans.h (gfc_trans_runtime_check): Change prototype accordingly.
	(gfc_msg_bounds, gfc_msg_fault, gfc_msg_wrong_return): Add proto.
	* trans-const.c (gfc_strconst_bounds, gfc_strconst_fault,
	gfc_strconst_wrong_return, gfc_strconst_current_filename): Remove.
	(gfc_init_constants): Likewise.
	* trans-const.h: Likewise.
	* trans-decl.c (gfc_build_builtin_function_decls): Call to
	_gfortran_runtime_error has only one argument, the message string.
	* trans-array.h (gfc_conv_array_ref): Add a symbol argument and a
	locus.
	* trans-array.c (gfc_trans_array_bound_check): Build precise
	error messages.
	(gfc_conv_array_ref): Use the new symbol argument and the locus
	to build more precise error messages.
	(gfc_conv_ss_startstride): More precise error messages.
	* trans-expr.c (gfc_conv_variable): Give symbol reference and
	locus to gfc_conv_array_ref.
	(gfc_conv_function_call): Use the new prototype for
	gfc_trans_runtime_check.
	* trans-stmt.c (gfc_trans_goto): Build more precise error message.
	* trans-io.c (set_string): Likewise.
	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Use new prototype
	for gfc_trans_runtime_check.

From-SVN: r114346

1 files changed, 56 insertions, 26 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index be640bb..26d5feb 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1767,23 +1767,40 @@ gfc_conv_array_ubound (tree descriptor, int dim)
 static tree
 gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n)
 {
-  tree cond;
   tree fault;
   tree tmp;
+  char *msg;
 
   if (!flag_bounds_check)
     return index;
 
   index = gfc_evaluate_now (index, &se->pre);
+
   /* Check lower bound.  */
   tmp = gfc_conv_array_lbound (descriptor, n);
   fault = fold_build2 (LT_EXPR, boolean_type_node, index, tmp);
+  if (se->ss)
+    asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded",
+	      gfc_msg_fault, se->ss->expr->symtree->name, n+1);
+  else
+    asprintf (&msg, "%s, lower bound of dimension %d exceeded",
+	      gfc_msg_fault, n+1);
+  gfc_trans_runtime_check (fault, msg, &se->pre,
+			   (se->ss ? &se->ss->expr->where : NULL));
+  gfc_free (msg);
+
   /* Check upper bound.  */
   tmp = gfc_conv_array_ubound (descriptor, n);
-  cond = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
-  fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond);
-
-  gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre);
+  fault = fold_build2 (GT_EXPR, boolean_type_node, index, tmp);
+  if (se->ss)
+    asprintf (&msg, "%s for array '%s', upper bound of dimension %d exceeded",
+	      gfc_msg_fault, se->ss->expr->symtree->name, n+1);
+  else
+    asprintf (&msg, "%s, upper bound of dimension %d exceeded",
+	      gfc_msg_fault, n+1);
+  gfc_trans_runtime_check (fault, msg, &se->pre,
+			   (se->ss ? &se->ss->expr->where : NULL));
+  gfc_free (msg);
 
   return index;
 }
@@ -1919,13 +1936,13 @@ gfc_conv_tmp_array_ref (gfc_se * se)
    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_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
+		    locus * where)
 {
   int n;
   tree index;
   tree tmp;
   tree stride;
-  tree fault;
   gfc_se indexse;
 
   /* Handle scalarized references separately.  */
@@ -1938,8 +1955,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
 
   index = gfc_index_zero_node;
 
-  fault = gfc_index_zero_node;
-
   /* Calculate the offsets from all the dimensions.  */
   for (n = 0; n < ar->dimen; n++)
     {
@@ -1953,20 +1968,27 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
 	{
 	  /* Check array bounds.  */
 	  tree cond;
+	  char *msg;
 
 	  indexse.expr = gfc_evaluate_now (indexse.expr, &se->pre);
 
 	  tmp = gfc_conv_array_lbound (se->expr, n);
 	  cond = fold_build2 (LT_EXPR, boolean_type_node, 
 			      indexse.expr, tmp);
-	  fault =
-	    fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond);
+	  asprintf (&msg, "%s for array '%s', "
+	            "lower bound of dimension %d exceeded", gfc_msg_fault,
+		    sym->name, n+1);
+	  gfc_trans_runtime_check (cond, msg, &se->pre, where);
+	  gfc_free (msg);
 
 	  tmp = gfc_conv_array_ubound (se->expr, n);
 	  cond = fold_build2 (GT_EXPR, boolean_type_node, 
 			      indexse.expr, tmp);
-	  fault =
-	    fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault, cond);
+	  asprintf (&msg, "%s for array '%s', "
+	            "upper bound of dimension %d exceeded", gfc_msg_fault,
+		    sym->name, n+1);
+	  gfc_trans_runtime_check (cond, msg, &se->pre, where);
+	  gfc_free (msg);
 	}
 
       /* Multiply the index by the stride.  */
@@ -1978,9 +2000,6 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar)
       index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, tmp);
     }
 
-  if (flag_bounds_check)
-    gfc_trans_runtime_check (fault, gfc_strconst_fault, &se->pre);
-
   tmp = gfc_conv_array_offset (se->expr);
   if (!integer_zerop (tmp))
     index = fold_build2 (PLUS_EXPR, gfc_array_index_type, index, tmp);
@@ -2457,16 +2476,15 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
   if (flag_bounds_check)
     {
       stmtblock_t block;
-      tree fault;
       tree bound;
       tree end;
       tree size[GFC_MAX_DIMENSIONS];
       gfc_ss_info *info;
+      char *msg;
       int dim;
 
       gfc_start_block (&block);
 
-      fault = boolean_false_node;
       for (n = 0; n < loop->dimen; n++)
 	size[n] = NULL_TREE;
 
@@ -2492,15 +2510,21 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	      bound = gfc_conv_array_lbound (desc, dim);
 	      tmp = info->start[n];
 	      tmp = fold_build2 (LT_EXPR, boolean_type_node, tmp, bound);
-	      fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault,
-				   tmp);
+	      asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
+			" exceeded", gfc_msg_bounds, n+1,
+			ss->expr->symtree->name);
+	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+	      gfc_free (msg);
 
 	      /* Check the upper bound.  */
 	      bound = gfc_conv_array_ubound (desc, dim);
 	      end = gfc_conv_section_upper_bound (ss, n, &block);
 	      tmp = fold_build2 (GT_EXPR, boolean_type_node, end, bound);
-	      fault = fold_build2 (TRUTH_OR_EXPR, boolean_type_node, fault,
-				   tmp);
+	      asprintf (&msg, "%s, upper bound of dimension %d of array '%s'"
+			" exceeded", gfc_msg_bounds, n+1,
+			ss->expr->symtree->name);
+	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+	      gfc_free (msg);
 
 	      /* Check the section sizes match.  */
 	      tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type, end,
@@ -2513,14 +2537,16 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 		{
 		  tmp =
 		    fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
-		  fault =
-		    build2 (TRUTH_OR_EXPR, boolean_type_node, fault, tmp);
+		  asprintf (&msg, "%s, size mismatch for dimension %d "
+			    "of array '%s'", gfc_msg_bounds, n+1,
+			    ss->expr->symtree->name);
+		  gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+		  gfc_free (msg);
 		}
 	      else
 		size[n] = gfc_evaluate_now (tmp, &block);
 	    }
 	}
-      gfc_trans_runtime_check (fault, gfc_strconst_bounds, &block);
 
       tmp = gfc_finish_block (&block);
       gfc_add_expr_to_block (&loop->pre, tmp);
@@ -3709,13 +3735,17 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
 	  if (checkparm)
 	    {
 	      /* Check (ubound(a) - lbound(a) == ubound(b) - lbound(b)).  */
+	      char * msg;
 
 	      tmp = fold_build2 (MINUS_EXPR, gfc_array_index_type,
 				 ubound, lbound);
               stride2 = build2 (MINUS_EXPR, gfc_array_index_type,
 			       dubound, dlbound);
               tmp = fold_build2 (NE_EXPR, gfc_array_index_type, tmp, stride2);
-	      gfc_trans_runtime_check (tmp, gfc_strconst_bounds, &block);
+	      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_free (msg);
 	    }
 	}
       else