Fortran: improve runtime error message with ALLOCATE and, ERRMSG= [PR91300]

Message ID 8f8592d1-93b0-5092-dcf7-62b91dd5a767@gmx.de
State New
Headers
Series Fortran: improve runtime error message with ALLOCATE and, ERRMSG= [PR91300] |

Commit Message

Harald Anlauf May 30, 2022, 8:53 p.m. UTC
  Hi Tobias,

Am 30.05.22 um 09:33 schrieb Tobias Burnus:
> On 28.05.22 22:25, Harald Anlauf via Fortran wrote:
>> the PR rightfully complained that we did not differentiate errors on
>> ALLOCATE(...,stat=,errmsg=) for failures from allocation of already
>> allocated objects or insufficient virtual memory.
> It is even worse: The error message states the wrong reason.
>> The attached patch introduces a new STAT value LIBERROR_NO_MEMORY
>> that is returned for insufficient virtual memory, and a corresponding
>> (simple and invariant) ERRMSG: "Insufficient virtual memory".
> I think the message is fine – at least on Linux 'virtual memory' is
> what's used and it is clear what's meant, even if I stumble a bit about
> the wording. (But do not have a crisp short & comprehensive wording
> myself.)

for reference these are the messages of selected compilers:

ifort: insufficient virtual memory
nag: Out of memory
crayftn: The program was unable to request more memory space.

And since Intel's message for attempting to allocate an already
allocated object was closest to gfortran's version, and Cray is
far too verbose for my taste, I threw mental dice between Intel
and NAG, and Intel won.

>> (In the PR Janne mentions checking for errno, but since the standard
>> malloc(3) only mentions ENOMEM as possible error value, and the user
>> may replace malloc by a special library, I believe that won't be easy
>> to handle in a general way.)
> I con concur. Especially as POSIX and the Linux manpage only list ENOMEM
> as only value.
>> Most compilers I tried (Intel/NAG/Crayftn) behave similarly, except
>> for Nvidia/Flang, which try to return the size of the allocation in
>> the error message.
>>
>> I am not sure that this is worth the effort.
> I think it is not needed – especially as we generate the message in the
> FE and not in libgfortran. The advantage for the users is that they know
> what value has been requested – but they cannot really do much with the
> knowledge, either.

Thanks for confirming this.

>> The testcase should be able to handle 32 and 64 bit systems.
>> At least that's what I think.
>
> I hope it is – at least on 64bit, I currently expect it too fail
> somewhat reliably, with 32bit I think it won't – but that's also handled.
>
> But you could add a -fdump-tree-original + '! { dg-final {
> scan-tree-dump*' to do some checking in addition (e.g. whether both
> strings appear in the dump; could be more complex, but that's probably
> not needed).
>
>> Regtested on x86_64-pc-linux-gnu.  OK for mainline?  Suggestions?
>
> LGTM – with considering comments on the testcase.
>
>
>> Fortran: improve runtime error message with ALLOCATE and ERRMSG=
>
> Consider appending [PR91300] in that line – and try to make the
> gcc-patches@ and fortran@ lines the same
>
> (Searching for the PR number or case-insignificantly for the string in
> the mailing list archive, will fine the message; thus, that's okay.)

OK, will do from now on.  My visual parsing and reading ability of
subject lines is not really positive-correlated with their machine-
readability, but then gcc-patches@ is not what I'm reading... ;-)
(I consider it basically a write-only list).

>> ALLOCATE: generate different STAT,ERRMSG results for failures from
>> allocation of already allocated objects or insufficient virtual memory.
>>
>> gcc/fortran/ChangeLog:
>>
>>       PR fortran/91300
>>       * libgfortran.h: Define new error code LIBERROR_NO_MEMORY.
>>       * trans-stmt.cc (gfc_trans_allocate): Generate code for setting
>>       ERRMSG depending on result of STAT result of ALLOCATE.
>>       * trans.cc (gfc_allocate_using_malloc): Use STAT value of
>>       LIBERROR_NO_MEMORY in case of failed malloc.
>>
>> gcc/testsuite/ChangeLog:
>>
>>       PR fortran/91300
>>       * gfortran.dg/allocate_alloc_opt_15.f90: New test.
>> ---
> ...
>
>> +  stat1   = -1
>> +  errmsg1 = ""
>> +  allocate (array(1), stat=stat1, errmsg=errmsg1)
>> +  if (stat1   /=  0) stop 1
>> +  if (errmsg1 /= "") stop 1
> Consider to init the errmsg1 and then check that is has not been
> touched. (For completeness, I think we already have such tests).
>> +  ! Obtain stat,errmsg for attempt to allocate an allocated object
>> +  allocate (array(1), stat=stat1, errmsg=errmsg1)
>> +  if (stat1   ==  0) stop 2
>> +  if (errmsg1 == "") stop 2
> Consider to check (either here or as a third test) for the
> gfortran-specific error message.
>> +  stat2   = -1
>> +  errmsg2 = ""
>> +  ! Try to allocate very large object
>> +  allocate (bigarray(bignumber), stat=stat2, errmsg=errmsg2)
>> +  if (stat2 /= 0) then
>> +     print *, "stat  =", stat1
>> +     print *, "errmsg: ", trim (errmsg1)
>> +     print *, "stat  =", stat2
>> +     print *, "errmsg: ", trim (errmsg2)
>> +     ! Ensure different results for stat, errmsg variables
>> +     if (stat2   == stat1                     ) stop 3
>> +     if (errmsg2 == "" .or. errmsg2 == errmsg1) stop 4
>
> Likewise for errmsg2

I've adjusted the testcase as suggested and hardened it somewhat
against strange options like -fdefault-integer-8 -fdefault-real-8.
Committed and pushed as attached.

Thanks for the review!

Harald

> Thanks,
>
> Tobias
>
> -----------------
> Siemens Electronic Design Automation GmbH; Anschrift: Arnulfstraße 201,
> 80634 München; Gesellschaft mit beschränkter Haftung; Geschäftsführer:
> Thomas Heurung, Frank Thürauf; Sitz der Gesellschaft: München;
> Registergericht München, HRB 106955
>
  

Patch

From 871dbb6112e22ff92914613c332944fd19dd39a8 Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anlauf@gmx.de>
Date: Sat, 28 May 2022 22:02:20 +0200
Subject: [PATCH] Fortran: improve runtime error message with ALLOCATE and
 ERRMSG= [PR91300]

ALLOCATE: generate different STAT,ERRMSG results for failures from
allocation of already allocated objects or insufficient virtual memory.

gcc/fortran/ChangeLog:

	PR fortran/91300
	* libgfortran.h: Define new error code LIBERROR_NO_MEMORY.
	* trans-stmt.cc (gfc_trans_allocate): Generate code for setting
	ERRMSG depending on result of STAT result of ALLOCATE.
	* trans.cc (gfc_allocate_using_malloc): Use STAT value of
	LIBERROR_NO_MEMORY in case of failed malloc.

gcc/testsuite/ChangeLog:

	PR fortran/91300
	* gfortran.dg/allocate_alloc_opt_15.f90: New test.
---
 gcc/fortran/libgfortran.h                     |  1 +
 gcc/fortran/trans-stmt.cc                     | 33 +++++++++++--
 gcc/fortran/trans.cc                          |  4 +-
 .../gfortran.dg/allocate_alloc_opt_15.f90     | 49 +++++++++++++++++++
 4 files changed, 82 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/allocate_alloc_opt_15.f90

diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h
index 064795eb469..4328447be04 100644
--- a/gcc/fortran/libgfortran.h
+++ b/gcc/fortran/libgfortran.h
@@ -133,6 +133,7 @@  typedef enum
   LIBERROR_CORRUPT_FILE,
   LIBERROR_INQUIRE_INTERNAL_UNIT, /* Must be different from STAT_STOPPED_IMAGE.  */
   LIBERROR_BAD_WAIT_ID,
+  LIBERROR_NO_MEMORY,
   LIBERROR_LAST			/* Not a real error, the last error # + 1.  */
 }
 libgfortran_error_codes;
diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc
index 79096816c6e..fd6d294147e 100644
--- a/gcc/fortran/trans-stmt.cc
+++ b/gcc/fortran/trans-stmt.cc
@@ -7130,7 +7130,8 @@  gfc_trans_allocate (gfc_code * code)
   if (code->expr1 && code->expr2)
     {
       const char *msg = "Attempt to allocate an allocated object";
-      tree slen, dlen, errmsg_str;
+      const char *oommsg = "Insufficient virtual memory";
+      tree slen, dlen, errmsg_str, oom_str, oom_loc;
       stmtblock_t errmsg_block;
 
       gfc_init_block (&errmsg_block);
@@ -7151,8 +7152,34 @@  gfc_trans_allocate (gfc_code * code)
 			     gfc_default_character_kind);
       dlen = gfc_finish_block (&errmsg_block);
 
-      tmp = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
-			     stat, build_int_cst (TREE_TYPE (stat), 0));
+      tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			     stat, build_int_cst (TREE_TYPE (stat),
+						  LIBERROR_ALLOCATION));
+
+      tmp = build3_v (COND_EXPR, tmp,
+		      dlen, build_empty_stmt (input_location));
+
+      gfc_add_expr_to_block (&block, tmp);
+
+      oom_str = gfc_create_var (pchar_type_node, "OOMMSG");
+      oom_loc = gfc_build_localized_cstring_const (oommsg);
+      gfc_add_modify (&errmsg_block, oom_str,
+		      gfc_build_addr_expr (pchar_type_node, oom_loc));
+
+      slen = build_int_cst (gfc_charlen_type_node, strlen (oommsg));
+      dlen = gfc_get_expr_charlen (code->expr2);
+      slen = fold_build2_loc (input_location, MIN_EXPR,
+			      TREE_TYPE (slen), dlen, slen);
+
+      gfc_trans_string_copy (&errmsg_block, dlen, errmsg,
+			     code->expr2->ts.kind,
+			     slen, oom_str,
+			     gfc_default_character_kind);
+      dlen = gfc_finish_block (&errmsg_block);
+
+      tmp = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+			     stat, build_int_cst (TREE_TYPE (stat),
+						  LIBERROR_NO_MEMORY));
 
       tmp = build3_v (COND_EXPR, tmp,
 		      dlen, build_empty_stmt (input_location));
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index f0a5dfb50fc..912a206f2ed 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -772,7 +772,7 @@  gfc_call_malloc (stmtblock_t * block, tree type, tree size)
       if (newmem == NULL)
       {
         if (stat)
-          *stat = LIBERROR_ALLOCATION;
+	  *stat = LIBERROR_NO_MEMORY;
         else
 	  runtime_error ("Allocation would exceed memory limit");
       }
@@ -807,7 +807,7 @@  gfc_allocate_using_malloc (stmtblock_t * block, tree pointer,
   if (status != NULL_TREE)
     {
       tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, status,
-			     build_int_cst (status_type, LIBERROR_ALLOCATION));
+			     build_int_cst (status_type, LIBERROR_NO_MEMORY));
       gfc_add_expr_to_block (&on_error, tmp);
     }
   else
diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_15.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_15.f90
new file mode 100644
index 00000000000..3c26e8179cb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_15.f90
@@ -0,0 +1,49 @@ 
+! { dg-do run }
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/91300 - runtime error message with allocate and errmsg=
+! Contributed by zed.three
+
+program bigarray_prog
+  use, intrinsic :: iso_c_binding, only: C_INTPTR_T
+  implicit none
+  real(4), dimension(:), allocatable :: array, bigarray
+  integer                 :: stat1, stat2
+  character(len=100)      :: errmsg1, errmsg2
+  character(*), parameter :: no_error = "no error"
+  integer(8), parameter :: n1 = huge (1_4) / 3          ! request more than 2GB
+  integer(8), parameter :: n2 = huge (1_C_INTPTR_T) / 4 ! "safe" for 64bit
+  integer(8), parameter :: bignumber = max (n1, n2)
+
+  stat1   = -1
+  stat2   = -1
+  errmsg1 = no_error
+  errmsg2 = no_error
+  allocate (array(1), stat=stat1, errmsg=errmsg1)
+  if (stat1   /= 0       ) stop 1
+  if (errmsg1 /= no_error) stop 1
+
+  ! Obtain stat, errmsg for attempt to allocate an allocated object
+  allocate (array(1), stat=stat1, errmsg=errmsg1)
+  if (stat1   == 0       ) stop 2
+  if (errmsg1 == no_error) stop 2
+
+  ! Try to allocate very large object
+  allocate (bigarray(bignumber), stat=stat2, errmsg=errmsg2)
+  if (stat2 /= 0) then
+     print *, "stat1 =", stat1
+     print *, "errmsg: ", trim (errmsg1)
+     print *, "stat2 =", stat2
+     print *, "errmsg: ", trim (errmsg2)
+     ! Ensure different results for stat, errmsg variables (all compilers)
+     if (stat2   == stat1                           ) stop 3
+     if (errmsg2 == no_error .or. errmsg2 == errmsg1) stop 4
+
+     ! Finally verify gfortran-specific error messages
+     if (errmsg1 /= "Attempt to allocate an allocated object") stop 5
+     if (errmsg2 /= "Insufficient virtual memory"            ) stop 6
+  end if
+
+end program bigarray_prog
+
+! { dg-final { scan-tree-dump-times "Attempt to allocate an allocated object" 4 "original" } }
+! { dg-final { scan-tree-dump-times "Insufficient virtual memory" 4 "original" } }
-- 
2.35.3