re PR fortran/31270 (print subscript value and array bounds when out-of-bounds error occurs)

	PR fortran/31270

	* trans.c (gfc_trans_runtime_check): Reorder arguments and
	add extra variable arguments. Hand them to the library function.
	* trans.h (gfc_trans_runtime_check): Update prototype.
	* trans-array.c (gfc_trans_array_bound_check): Issue more
	detailled error messages.
	(gfc_conv_array_ref): Likewise.
	(gfc_conv_ss_startstride): Likewise.
	(gfc_trans_dummy_array_bias): Reorder arguments to
	gfc_trans_runtime_check.
	* trans-expr.c (gfc_conv_substring): Issue more detailled
	error messages.
	(gfc_conv_function_call): Reorder arguments to gfc_trans_runtime_check.
	* trans-stmt.c (gfc_trans_goto): Likewise.
	* trans-io.c (set_string): Reorder arguments to
	gfc_trans_runtime_check and issue a more detailled error message.
	* trans-decl.c (gfc_build_builtin_function_decls): Make
	runtime_error and runtime_error_at handle a variable number of
	arguments.
	* trans-intrinsic.c (gfc_conv_intrinsic_bound): Reorder arguments
	to gfc_trans_runtime_check.
	(gfc_conv_intrinsic_minmax): Likewise.
	(gfc_conv_intrinsic_repeat): Issue more detailled error messages.

	* runtime/error.c (runtime_error_at): Add a variable number of
	arguments.
	* libgfortran.h (runtime_error_at): Update prototype.

From-SVN: r127352

1 files changed, 55 insertions, 29 deletions

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index abbf8f6..78b038a 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -2097,9 +2097,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
     asprintf (&msg, "%s for array '%s', lower bound of dimension %d exceeded",
 	      gfc_msg_fault, 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, where);
+    asprintf (&msg, "%s, lower bound of dimension %d exceeded, %%ld is "
+	      "smaller than %%ld", gfc_msg_fault, n+1);
+  gfc_trans_runtime_check (fault, &se->pre, where, msg,
+			   fold_convert (long_integer_type_node, index),
+			   fold_convert (long_integer_type_node, tmp));
   gfc_free (msg);
 
   /* Check upper bound.  */
@@ -2111,9 +2113,11 @@ gfc_trans_array_bound_check (gfc_se * se, tree descriptor, tree index, int n,
 	asprintf (&msg, "%s for array '%s', upper bound of dimension %d "
 			" exceeded", gfc_msg_fault, 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, where);
+	asprintf (&msg, "%s, upper bound of dimension %d exceeded, %%ld is "
+		  "larger than %%ld", gfc_msg_fault, n+1);
+      gfc_trans_runtime_check (fault, &se->pre, where, msg,
+			       fold_convert (long_integer_type_node, index),
+			       fold_convert (long_integer_type_node, tmp));
       gfc_free (msg);
     }
 
@@ -2300,9 +2304,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
 	  cond = fold_build2 (LT_EXPR, boolean_type_node, 
 			      indexse.expr, tmp);
 	  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);
+	            "lower bound of dimension %d exceeded, %%ld is smaller "
+		    "than %%ld", gfc_msg_fault, sym->name, n+1);
+	  gfc_trans_runtime_check (cond, &se->pre, where, msg,
+				   fold_convert (long_integer_type_node,
+						 indexse.expr),
+				   fold_convert (long_integer_type_node, tmp));
 	  gfc_free (msg);
 
 	  /* Upper bound, but not for the last dimension of assumed-size
@@ -2314,9 +2321,12 @@ gfc_conv_array_ref (gfc_se * se, gfc_array_ref * ar, gfc_symbol * sym,
 	      cond = fold_build2 (GT_EXPR, boolean_type_node, 
 				  indexse.expr, tmp);
 	      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);
+			"upper bound of dimension %d exceeded, %%ld is "
+			"greater than %%ld", gfc_msg_fault, sym->name, n+1);
+	      gfc_trans_runtime_check (cond, &se->pre, where, msg,
+				   fold_convert (long_integer_type_node,
+						 indexse.expr),
+				   fold_convert (long_integer_type_node, tmp));
 	      gfc_free (msg);
 	    }
 	}
@@ -2872,7 +2882,7 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	      asprintf (&msg, "Zero stride is not allowed, for dimension %d "
 			"of array '%s'", info->dim[n]+1,
 			ss->expr->symtree->name);
-	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+	      gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg);
 	      gfc_free (msg);
 
 	      desc = ss->data.info.descriptor;
@@ -2912,9 +2922,13 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	      tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
 				 non_zerosized, tmp);
 	      asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
-			" exceeded", gfc_msg_fault, info->dim[n]+1,
-			ss->expr->symtree->name);
-	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+			" exceeded, %%ld is smaller than %%ld", gfc_msg_fault,
+			info->dim[n]+1, ss->expr->symtree->name);
+	      gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
+				       fold_convert (long_integer_type_node,
+						     info->start[n]),
+				       fold_convert (long_integer_type_node,
+						     lbound));
 	      gfc_free (msg);
 
 	      if (check_upper)
@@ -2924,9 +2938,12 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 		  tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
 				     non_zerosized, tmp);
 	          asprintf (&msg, "%s, upper bound of dimension %d of array "
-			    "'%s' exceeded", gfc_msg_fault, info->dim[n]+1,
+			    "'%s' exceeded, %%ld is greater than %%ld",
+			    gfc_msg_fault, info->dim[n]+1,
 			    ss->expr->symtree->name);
-		  gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+		  gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
+			fold_convert (long_integer_type_node, info->start[n]),
+			fold_convert (long_integer_type_node, ubound));
 		  gfc_free (msg);
 		}
 
@@ -2944,9 +2961,13 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	      tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
 				 non_zerosized, tmp);
 	      asprintf (&msg, "%s, lower bound of dimension %d of array '%s'"
-			" exceeded", gfc_msg_fault, info->dim[n]+1,
-			ss->expr->symtree->name);
-	      gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+			" exceeded, %%ld is smaller than %%ld", gfc_msg_fault,
+			info->dim[n]+1, ss->expr->symtree->name);
+	      gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
+				       fold_convert (long_integer_type_node,
+						     tmp2),
+				       fold_convert (long_integer_type_node,
+						     lbound));
 	      gfc_free (msg);
 
 	      if (check_upper)
@@ -2955,9 +2976,12 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 		  tmp = fold_build2 (TRUTH_AND_EXPR, boolean_type_node,
 				     non_zerosized, tmp);
 		  asprintf (&msg, "%s, upper bound of dimension %d of array "
-			    "'%s' exceeded", gfc_msg_fault, info->dim[n]+1,
+			    "'%s' exceeded, %%ld is greater than %%ld",
+			    gfc_msg_fault, info->dim[n]+1,
 			    ss->expr->symtree->name);
-		  gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+		  gfc_trans_runtime_check (tmp, &block, &ss->expr->where, msg,
+			fold_convert (long_integer_type_node, tmp2),
+			fold_convert (long_integer_type_node, ubound));
 		  gfc_free (msg);
 		}
 
@@ -2970,12 +2994,14 @@ gfc_conv_ss_startstride (gfc_loopinfo * loop)
 	         others against this.  */
 	      if (size[n])
 		{
-		  tmp =
-		    fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
+		  tree tmp3
+		    = fold_build2 (NE_EXPR, boolean_type_node, tmp, size[n]);
 		  asprintf (&msg, "%s, size mismatch for dimension %d "
-			    "of array '%s'", gfc_msg_bounds, info->dim[n]+1,
-			    ss->expr->symtree->name);
-		  gfc_trans_runtime_check (tmp, msg, &block, &ss->expr->where);
+			    "of array '%s' (%%ld/%%ld)", gfc_msg_bounds,
+			    info->dim[n]+1, ss->expr->symtree->name);
+		  gfc_trans_runtime_check (tmp3, &block, &ss->expr->where, msg,
+			fold_convert (long_integer_type_node, tmp),
+			fold_convert (long_integer_type_node, size[n]));
 		  gfc_free (msg);
 		}
 	      else
@@ -4194,7 +4220,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, &loc);
+	      gfc_trans_runtime_check (tmp, &block, &loc, msg);
 	      gfc_free (msg);
 	    }
 	}