public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] PR fortran/91300 - runtime error message with allocate and errmsg=
@ 2022-05-28 20:25 Harald Anlauf
  2022-05-30  7:33 ` Tobias Burnus
  0 siblings, 1 reply; 3+ messages in thread
From: Harald Anlauf @ 2022-05-28 20:25 UTC (permalink / raw)
  To: fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 1386 bytes --]

Dear Fortranners,

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.

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".

(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.)

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.  First, ERRMSG is very
compiler-dependent anyway and thus not really portable.  If a user
wants to know what the size of the failed allocation is and really
wants to recover, he/she should find that out himself.  Second, I
think that the more important change is the introduction of a STAT
value that allows the distinction between the different causes of
failure.

The testcase should be able to handle 32 and 64 bit systems.
At least that's what I think.

Regtested on x86_64-pc-linux-gnu.  OK for mainline?  Suggestions?

Thanks,
Harald


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fortran-improve-runtime-error-message-with-ALLOCATE-.patch --]
[-- Type: text/x-patch, Size: 6285 bytes --]

From 19ccd22ee9359bd14b32a95bd9efcaead3593b2f 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=

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     | 40 +++++++++++++++++++
 4 files changed, 73 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..04f7bf11970
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_15.f90
@@ -0,0 +1,40 @@
+! { dg-do run }
+! 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, dimension(:), allocatable :: array, bigarray
+  integer :: stat1, stat2
+  character(len=100) :: errmsg1, errmsg2
+  integer(8), parameter :: n1 = huge (1) / 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
+  errmsg1 = ""
+  allocate (array(1), stat=stat1, errmsg=errmsg1)
+  if (stat1   /=  0) stop 1
+  if (errmsg1 /= "") 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 == "") stop 2
+
+  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
+  end if
+
+end program bigarray_prog
--
2.35.3


^ permalink raw reply	[flat|nested] 3+ messages in thread

* Re: [PATCH] PR fortran/91300 - runtime error message with allocate and errmsg=
  2022-05-28 20:25 [PATCH] PR fortran/91300 - runtime error message with allocate and errmsg= Harald Anlauf
@ 2022-05-30  7:33 ` Tobias Burnus
  2022-05-30 20:53   ` [PATCH] Fortran: improve runtime error message with ALLOCATE and, ERRMSG= [PR91300] Harald Anlauf
  0 siblings, 1 reply; 3+ messages in thread
From: Tobias Burnus @ 2022-05-30  7:33 UTC (permalink / raw)
  To: Harald Anlauf, fortran, gcc-patches

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.)
> (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.
> 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.)

> 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

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

^ permalink raw reply	[flat|nested] 3+ messages in thread

* [PATCH] Fortran: improve runtime error message with ALLOCATE and, ERRMSG= [PR91300]
  2022-05-30  7:33 ` Tobias Burnus
@ 2022-05-30 20:53   ` Harald Anlauf
  0 siblings, 0 replies; 3+ messages in thread
From: Harald Anlauf @ 2022-05-30 20:53 UTC (permalink / raw)
  To: Tobias Burnus, fortran, gcc-patches

[-- Attachment #1: Type: text/plain, Size: 5743 bytes --]

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
>

[-- Attachment #2: 0001-Fortran-improve-runtime-error-message-with-ALLOCATE-.patch --]
[-- Type: text/x-patch, Size: 6708 bytes --]

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


^ permalink raw reply	[flat|nested] 3+ messages in thread

end of thread, other threads:[~2022-05-30 20:53 UTC | newest]

Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-05-28 20:25 [PATCH] PR fortran/91300 - runtime error message with allocate and errmsg= Harald Anlauf
2022-05-30  7:33 ` Tobias Burnus
2022-05-30 20:53   ` [PATCH] Fortran: improve runtime error message with ALLOCATE and, ERRMSG= [PR91300] Harald Anlauf

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).