PR fortran/68401 Improve allocation error message

Message ID 20190816143136.10583-1-blomqvist.janne@gmail.com
State New
Headers show
Series
  • PR fortran/68401 Improve allocation error message
Related show

Commit Message

Janne Blomqvist Aug. 16, 2019, 2:31 p.m.
Improve the error message that is printed when a memory allocation
fails, by including the location, and the size of the allocation that
failed.

Regtested on x86_64-pc-linux-gnu, Ok for trunk?

(libgomp.fortran/appendix-a/a.28.5.f90 fails, but that seems
unrelated)

gcc/fortran/ChangeLog:

2019-08-16  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/68401
	* trans-decl.c (gfc_build_builtin_function_decls): Replace
	os_error with os_error_at decl.
	* trans.c (trans_runtime_error_vararg): Modify so the error
	function decl is passed directly.
	(gfc_trans_runtime_error): Pass correct error function decl.
	(gfc_trans_runtime_check): Likewise.
	(trans_os_error_at): New function.
	(gfc_call_malloc): Use trans_os_error_at.
	(gfc_allocate_using_malloc): Likewise.
	(gfc_call_realloc): Likewise.
	* trans.h (gfor_fndecl_os_error): Replace with gfor_fndecl_os_error_at.

libgfortran/ChangeLog:

2019-08-16  Janne Blomqvist  <jb@gcc.gnu.org>

	PR fortran/68401
	* gfortran.map: Add GFORTRAN_10 node, add _gfortran_os_error_at
	symbol.
	* libgfortran.h (os_error_at): New prototype.
	* runtime/error.c (os_error_at): New function.
---
 gcc/fortran/trans-decl.c    | 12 +++----
 gcc/fortran/trans.c         | 68 ++++++++++++++++++++++---------------
 gcc/fortran/trans.h         |  2 +-
 libgfortran/gfortran.map    |  5 +++
 libgfortran/libgfortran.h   |  4 +++
 libgfortran/runtime/error.c | 46 ++++++++++++++++++++++++-
 6 files changed, 102 insertions(+), 35 deletions(-)

-- 
2.17.1

Comments

Steve Kargl Aug. 16, 2019, 11:36 p.m. | #1
On Fri, Aug 16, 2019 at 05:31:36PM +0300, Janne Blomqvist wrote:
> Improve the error message that is printed when a memory allocation

> fails, by including the location, and the size of the allocation that

> failed.

> 

> Regtested on x86_64-pc-linux-gnu, Ok for trunk?

> 


Looks good to me.

-- 
Steve
Thomas Schwinge Oct. 8, 2019, 10:26 a.m. | #2
Hi!

On 2019-08-16T17:31:36+0300, Janne Blomqvist <blomqvist.janne@gmail.com> wrote:
> Improve the error message that is printed when a memory allocation

> fails, by including the location, and the size of the allocation that

> failed.


> 	* runtime/error.c (os_error_at): New function.


Committed the attached in r276691 to "Extend
'libgfortran/runtime/minimal.c' per r274599 "PR fortran/68401 Improve
allocation error message"".


Grüße
 Thomas
From 19c0ab5ba623bfe5926f3be04306399f9fc8dd8e Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>

Date: Tue, 8 Oct 2019 10:20:41 +0000
Subject: [PATCH 2/3] Extend 'libgfortran/runtime/minimal.c' per r274599 "PR
 fortran/68401 Improve allocation error message"

	libgfortran/
	PR fortran/68401
	* runtime/minimal.c (os_error_at): New function.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@276691 138bc75d-0d04-0410-961f-82ee72b054a4
---
 libgfortran/ChangeLog         |  3 +++
 libgfortran/runtime/minimal.c | 23 ++++++++++++++++++++++-
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 9e3b1f8bad8..c5a45333042 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,5 +1,8 @@
 2019-10-08  Thomas Schwinge  <thomas@codesourcery.com>
 
+	PR fortran/68401
+        * runtime/minimal.c (os_error_at): New function.
+
 	* runtime/minimal.c: Revise.
 
 2019-10-05  Paul Thomas  <pault@gcc.gnu.org>
diff --git a/libgfortran/runtime/minimal.c b/libgfortran/runtime/minimal.c
index a633bc1ce0f..bdaf878ffcb 100644
--- a/libgfortran/runtime/minimal.c
+++ b/libgfortran/runtime/minimal.c
@@ -215,7 +215,28 @@ os_error (const char *message)
   estr_write ("\n");
   exit_error (1);
 }
-iexport(os_error);
+iexport(os_error); /* TODO, DEPRECATED, ABI: Should not be exported
+		      anymore when bumping so version.  */
+
+
+/* Improved version of os_error with a printf style format string and
+   a locus.  */
+
+void
+os_error_at (const char *where, const char *message, ...)
+{
+  va_list ap;
+
+  recursion_check ();
+  estr_write (where);
+  estr_write (": ");
+  va_start (ap, message);
+  estr_vprintf (message, ap);
+  va_end (ap);
+  estr_write ("\n");
+  exit_error (1);
+}
+iexport(os_error_at);
 
 
 /* void runtime_error()-- These are errors associated with an
-- 
2.17.1

Patch

diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 2a9b852568a..3c6ab60e9b2 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -102,7 +102,7 @@  tree gfor_fndecl_error_stop_string;
 tree gfor_fndecl_runtime_error;
 tree gfor_fndecl_runtime_error_at;
 tree gfor_fndecl_runtime_warning_at;
-tree gfor_fndecl_os_error;
+tree gfor_fndecl_os_error_at;
 tree gfor_fndecl_generate_error;
 tree gfor_fndecl_set_args;
 tree gfor_fndecl_set_fpe;
@@ -3679,11 +3679,11 @@  gfc_build_builtin_function_decls (void)
 	void_type_node, 3, pvoid_type_node, integer_type_node,
 	pchar_type_node);
 
-  gfor_fndecl_os_error = gfc_build_library_function_decl_with_spec (
-	get_identifier (PREFIX("os_error")), ".R",
-	void_type_node, 1, pchar_type_node);
-  /* The runtime_error function does not return.  */
-  TREE_THIS_VOLATILE (gfor_fndecl_os_error) = 1;
+  gfor_fndecl_os_error_at = gfc_build_library_function_decl_with_spec (
+	get_identifier (PREFIX("os_error_at")), ".RR",
+	void_type_node, -2, pchar_type_node, pchar_type_node);
+  /* The os_error_at function does not return.  */
+  TREE_THIS_VOLATILE (gfor_fndecl_os_error_at) = 1;
 
   gfor_fndecl_set_args = gfc_build_library_function_decl (
 	get_identifier (PREFIX("set_args")),
diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c
index 84511477b39..583f6e3b25b 100644
--- a/gcc/fortran/trans.c
+++ b/gcc/fortran/trans.c
@@ -447,7 +447,7 @@  gfc_build_array_ref (tree base, tree offset, tree decl, tree vptr)
    arguments and a locus.  */
 
 static tree
-trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
+trans_runtime_error_vararg (tree errorfunc, locus* where, const char* msgid,
 			    va_list ap)
 {
   stmtblock_t block;
@@ -501,18 +501,13 @@  trans_runtime_error_vararg (bool error, locus* where, const char* msgid,
   /* Build the function call to runtime_(warning,error)_at; because of the
      variable number of arguments, we can't use build_call_expr_loc dinput_location,
      irectly.  */
-  if (error)
-    fntype = TREE_TYPE (gfor_fndecl_runtime_error_at);
-  else
-    fntype = TREE_TYPE (gfor_fndecl_runtime_warning_at);
+  fntype = TREE_TYPE (errorfunc);
 
   loc = where ? where->lb->location : input_location;
   tmp = fold_build_call_array_loc (loc, TREE_TYPE (fntype),
 				   fold_build1_loc (loc, ADDR_EXPR,
 					     build_pointer_type (fntype),
-					     error
-					     ? gfor_fndecl_runtime_error_at
-					     : gfor_fndecl_runtime_warning_at),
+					     errorfunc),
 				   nargs + 2, argarray);
   gfc_add_expr_to_block (&block, tmp);
 
@@ -527,7 +522,10 @@  gfc_trans_runtime_error (bool error, locus* where, const char* msgid, ...)
   tree result;
 
   va_start (ap, msgid);
-  result = trans_runtime_error_vararg (error, where, msgid, ap);
+  result = trans_runtime_error_vararg (error
+				       ? gfor_fndecl_runtime_error_at
+				       : gfor_fndecl_runtime_warning_at,
+				       where, msgid, ap);
   va_end (ap);
   return result;
 }
@@ -566,8 +564,10 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
   /* The code to generate the error.  */
   va_start (ap, msgid);
   gfc_add_expr_to_block (&block,
-			 trans_runtime_error_vararg (error, where,
-						     msgid, ap));
+			 trans_runtime_error_vararg
+			 (error ? gfor_fndecl_runtime_error_at
+			  : gfor_fndecl_runtime_warning_at,
+			  where, msgid, ap));
   va_end (ap);
 
   if (once)
@@ -595,13 +595,28 @@  gfc_trans_runtime_check (bool error, bool once, tree cond, stmtblock_t * pblock,
 }
 
 
+static tree
+trans_os_error_at (locus* where, const char* msgid, ...)
+{
+  va_list ap;
+  tree result;
+
+  va_start (ap, msgid);
+  result = trans_runtime_error_vararg (gfor_fndecl_os_error_at,
+				       where, msgid, ap);
+  va_end (ap);
+  return result;
+}
+
+
+
 /* Call malloc to allocate size bytes of memory, with special conditions:
       + if size == 0, return a malloced area of size 1,
       + if malloc returns NULL, issue a runtime error.  */
 tree
 gfc_call_malloc (stmtblock_t * block, tree type, tree size)
 {
-  tree tmp, msg, malloc_result, null_result, res, malloc_tree;
+  tree tmp, malloc_result, null_result, res, malloc_tree;
   stmtblock_t block2;
 
   /* Create a variable to hold the result.  */
@@ -626,13 +641,14 @@  gfc_call_malloc (stmtblock_t * block, tree type, tree size)
       null_result = fold_build2_loc (input_location, EQ_EXPR,
 				     logical_type_node, res,
 				     build_int_cst (pvoid_type_node, 0));
-      msg = gfc_build_addr_expr (pchar_type_node,
-	      gfc_build_localized_cstring_const ("Memory allocation failed"));
       tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 			     null_result,
-	      build_call_expr_loc (input_location,
-				   gfor_fndecl_os_error, 1, msg),
-				   build_empty_stmt (input_location));
+			     trans_os_error_at (NULL,
+						"Error allocating %lu bytes",
+						fold_convert
+						(long_unsigned_type_node,
+						 size)),
+			     build_empty_stmt (input_location));
       gfc_add_expr_to_block (&block2, tmp);
     }
 
@@ -701,11 +717,9 @@  gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
     }
   else
     {
-      /* Here, os_error already implies PRED_NORETURN.  */
-      tmp = build_call_expr_loc (input_location, gfor_fndecl_os_error, 1,
-		    gfc_build_addr_expr (pchar_type_node,
-				 gfc_build_localized_cstring_const
-				    ("Allocation would exceed memory limit")));
+      /* Here, os_error_at already implies PRED_NORETURN.  */
+      tree lusize = fold_convert (long_unsigned_type_node, size);
+      tmp = trans_os_error_at (NULL, "Error allocating %lu bytes", lusize);
       gfc_add_expr_to_block (&on_error, tmp);
     }
 
@@ -1664,7 +1678,7 @@  internal_realloc (void *mem, size_t size)
 tree
 gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
 {
-  tree msg, res, nonzero, null_result, tmp;
+  tree res, nonzero, null_result, tmp;
   tree type = TREE_TYPE (mem);
 
   /* Only evaluate the size once.  */
@@ -1684,12 +1698,12 @@  gfc_call_realloc (stmtblock_t * block, tree mem, tree size)
 			     build_int_cst (size_type_node, 0));
   null_result = fold_build2_loc (input_location, TRUTH_AND_EXPR, logical_type_node,
 				 null_result, nonzero);
-  msg = gfc_build_addr_expr (pchar_type_node, gfc_build_localized_cstring_const
-			     ("Allocation would exceed memory limit"));
   tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node,
 			 null_result,
-			 build_call_expr_loc (input_location,
-					      gfor_fndecl_os_error, 1, msg),
+			 trans_os_error_at (NULL,
+					    "Error reallocating to %lu bytes",
+					    fold_convert
+					    (long_unsigned_type_node, size)),
 			 build_empty_stmt (input_location));
   gfc_add_expr_to_block (block, tmp);
 
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index a3726e84140..8082b414df1 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -803,7 +803,7 @@  extern GTY(()) tree gfor_fndecl_error_stop_string;
 extern GTY(()) tree gfor_fndecl_runtime_error;
 extern GTY(()) tree gfor_fndecl_runtime_error_at;
 extern GTY(()) tree gfor_fndecl_runtime_warning_at;
-extern GTY(()) tree gfor_fndecl_os_error;
+extern GTY(()) tree gfor_fndecl_os_error_at;
 extern GTY(()) tree gfor_fndecl_generate_error;
 extern GTY(()) tree gfor_fndecl_set_fpe;
 extern GTY(()) tree gfor_fndecl_set_options;
diff --git a/libgfortran/gfortran.map b/libgfortran/gfortran.map
index 2b2243b4fd4..3601bc24414 100644
--- a/libgfortran/gfortran.map
+++ b/libgfortran/gfortran.map
@@ -1602,3 +1602,8 @@  GFORTRAN_9.2 {
   _gfortran_mfindloc1_r10;
   _gfortran_sfindloc1_r10;
 } GFORTRAN_9;
+
+GFORTRAN_10 {
+  global:
+  _gfortran_os_error_at;
+} GFORTRAN_9.2;
diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h
index c0db96f02a8..9f535b12e73 100644
--- a/libgfortran/libgfortran.h
+++ b/libgfortran/libgfortran.h
@@ -728,6 +728,10 @@  internal_proto(gfc_xtoa);
 extern _Noreturn void os_error (const char *);
 iexport_proto(os_error);
 
+extern _Noreturn void os_error_at (const char *, const char *, ...)
+  __attribute__ ((format (gfc_printf, 2, 3)));
+iexport_proto(os_error_at);
+
 extern void show_locus (st_parameter_common *);
 internal_proto(show_locus);
 
diff --git a/libgfortran/runtime/error.c b/libgfortran/runtime/error.c
index 0335a165edc..cbe0642f3f8 100644
--- a/libgfortran/runtime/error.c
+++ b/libgfortran/runtime/error.c
@@ -403,7 +403,51 @@  os_error (const char *message)
   estr_writev (iov, 5);
   exit_error (1);
 }
-iexport(os_error);
+iexport(os_error); /* TODO, DEPRECATED, ABI: Should not be exported
+		      anymore when bumping so version.  */
+
+
+/* Improved version of os_error with a printf style format string and
+   a locus.  */
+
+void
+os_error_at (const char *where, const char *message, ...)
+{
+  char errmsg[STRERR_MAXSZ];
+  char buffer[STRERR_MAXSZ];
+  struct iovec iov[6];
+  va_list ap;
+  recursion_check ();
+  int written;
+
+  iov[0].iov_base = (char*) where;
+  iov[0].iov_len = strlen (where);
+
+  iov[1].iov_base = (char*) ": ";
+  iov[1].iov_len = strlen (iov[1].iov_base);
+
+  va_start (ap, message);
+  written = vsnprintf (buffer, STRERR_MAXSZ, message, ap);
+  va_end (ap);
+  iov[2].iov_base = buffer;
+  if (written >= 0)
+    iov[2].iov_len = written;
+  else
+    iov[2].iov_len = 0;
+
+  iov[3].iov_base = (char*) ": ";
+  iov[3].iov_len = strlen (iov[3].iov_base);
+
+  iov[4].iov_base = gf_strerror (errno, errmsg, STRERR_MAXSZ);
+  iov[4].iov_len = strlen (iov[4].iov_base);
+
+  iov[5].iov_base = (char*) "\n";
+  iov[5].iov_len = 1;
+
+  estr_writev (iov, 6);
+  exit_error (1);
+}
+iexport(os_error_at);
 
 
 /* void runtime_error()-- These are errors associated with an