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, 23 insertions, 11 deletions

diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 3eec75c..d4856fd 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -46,6 +46,10 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 
 static gfc_file *gfc_current_backend_file;
 
+char gfc_msg_bounds[] = N_("Array bound mismatch");
+char gfc_msg_fault[] = N_("Array reference out of bounds");
+char gfc_msg_wrong_return[] = N_("Incorrect function return value");
+
 
 /* Advance along TREE_CHAIN n times.  */
 
@@ -302,12 +306,15 @@ gfc_build_array_ref (tree base, tree offset)
 /* Generate a runtime error if COND is true.  */
 
 void
-gfc_trans_runtime_check (tree cond, tree msg, stmtblock_t * pblock)
+gfc_trans_runtime_check (tree cond, const char * msgid, stmtblock_t * pblock,
+			 locus * where)
 {
   stmtblock_t block;
   tree body;
   tree tmp;
   tree args;
+  char * message;
+  int line;
 
   if (integer_zerop (cond))
     return;
@@ -315,19 +322,24 @@ gfc_trans_runtime_check (tree cond, tree msg, stmtblock_t * pblock)
   /* The code to generate the error.  */
   gfc_start_block (&block);
 
-  gcc_assert (TREE_CODE (msg) == STRING_CST);
-
-  TREE_USED (msg) = 1;
+  if (where)
+    {
+#ifdef USE_MAPPED_LOCATION
+      line = LOCATION_LINE (where->lb->location);
+#else 
+      line = where->lb->linenum;
+#endif
+      asprintf (&message, "%s (in file '%s', at line %d)", _(msgid),
+		where->lb->file->filename, line);
+    }
+  else
+    asprintf (&message, "%s (in file '%s', around line %d)", _(msgid),
+	      gfc_source_file, input_line + 1);
 
-  tmp = gfc_build_addr_expr (pchar_type_node, msg);
+  tmp = gfc_build_addr_expr (pchar_type_node, gfc_build_cstring_const(message));
+  gfc_free(message);
   args = gfc_chainon_list (NULL_TREE, tmp);
 
-  tmp = gfc_build_addr_expr (pchar_type_node, gfc_strconst_current_filename);
-  args = gfc_chainon_list (args, tmp);
-
-  tmp = build_int_cst (NULL_TREE, input_line);
-  args = gfc_chainon_list (args, tmp);
-
   tmp = build_function_call_expr (gfor_fndecl_runtime_error, args);
   gfc_add_expr_to_block (&block, tmp);