Dear all, this patch fixes the logic to generate the right STATUS when ALLOCATE with STATUS is used and the requested size exceeds virtual memory or the size calculation overflows, both for allocatables and for pointers.
(We currently do not distinguish between virtual memory exceeded from overflow. If this is desired, we would need a new error code in libgfortran for this purpose.) Before this patch, wrong status codes could be produced for already allocated allocatables, and sometimes also for pointers when the size was sufficiently large. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald
From df8a4fe29fb8c849134601102e7895958bd731af Mon Sep 17 00:00:00 2001 From: Harald Anlauf <[email protected]> Date: Wed, 11 Nov 2026 22:38:19 +0100 Subject: [PATCH] fortran: ALLOCATE with STATUS and overflow of array size [PR128656] For ALLOCATE with STATUS present, ensure that status is set to the "already allocated error" for an allocatable array only if it is already allocated, even if the size calculation would overflow or exceed virtual memory. For pointer arrays, only the virtual memory exceeded error can occur. PR fortran/128656 gcc/fortran/ChangeLog: * trans-array.cc (gfc_array_allocate): Push logic handling error status to gfc_allocate_allocatable for allocatable arrays. * trans.cc (gfc_allocate_allocatable): Implement the logic here. * trans.h (gfc_allocate_allocatable): Adjust prototype. gcc/testsuite/ChangeLog: * gfortran.dg/allocate_alloc_opt_16.f90: New test. --- gcc/fortran/trans-array.cc | 9 ++-- gcc/fortran/trans.cc | 20 ++++++- gcc/fortran/trans.h | 2 +- .../gfortran.dg/allocate_alloc_opt_16.f90 | 53 +++++++++++++++++++ 4 files changed, 79 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_alloc_opt_16.f90 diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 7cbf419469f..ea72cbd7ef5 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -6672,7 +6672,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_start_block (&set_status_block); gfc_add_modify (&set_status_block, status, - build_int_cst (status_type, LIBERROR_ALLOCATION)); + build_int_cst (status_type, LIBERROR_NO_MEMORY)); error = gfc_finish_block (&set_status_block); } } @@ -6760,7 +6760,8 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_allocate_allocatable (&elseblock, pointer, size, token, status, errmsg, errlen, label_finish, expr, coref != NULL ? coref->u.ar.as->corank : 0, - omp_cond, omp_alt_alloc, succ_add_expr); + omp_cond, omp_alt_alloc, succ_add_expr, + var_overflow); else if (non_ulimate_coarray_ptr_comp && token) /* The token is set only for GFC_FCOARRAY_LIB mode. */ gfc_allocate_using_caf_lib (&elseblock, pointer, size, token, status, @@ -6770,7 +6771,9 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg, gfc_allocate_using_malloc (&elseblock, pointer, size, status, omp_cond, omp_alt_alloc, succ_add_expr); - if (dimension) + /* When STATUS is present, we give precedence to "already allocated variable" + error over overflow error in gfc_allocate_allocatable. */ + if (dimension && !(allocatable && status)) { cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, logical_type_node, var_overflow, integer_zero_node), diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc index 2730ebf62c3..ff3bea5e1be 100644 --- a/gcc/fortran/trans.cc +++ b/gcc/fortran/trans.cc @@ -981,7 +981,8 @@ void gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, tree token, tree status, tree errmsg, tree errlen, tree label_finish, gfc_expr* expr, int corank, - tree cond, tree alt_alloc, tree extra_success_expr) + tree cond, tree alt_alloc, tree extra_success_expr, + tree var_overflow) { stmtblock_t alloc_block; tree tmp, null_mem, alloc, error; @@ -1112,6 +1113,23 @@ gfc_allocate_allocatable (stmtblock_t * block, tree mem, tree size, status, build_int_cst (status_type, LIBERROR_ALLOCATION)); } + /* When STATUS and a size overflow check are present, we give precedence to + "already allocated variable" error over overflow error. */ + if (status != NULL_TREE && var_overflow != NULL_TREE) + { + tree status_type = TREE_TYPE (status); + tree cond = gfc_unlikely (fold_build2_loc (input_location, NE_EXPR, + logical_type_node, + var_overflow, + integer_zero_node), + PRED_FORTRAN_OVERFLOW); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, status_type, + status, build_int_cst (status_type, + LIBERROR_NO_MEMORY)); + alloc = fold_build3_loc (input_location, COND_EXPR, void_type_node, + cond, tmp, alloc); + } + tmp = fold_build3_loc (input_location, COND_EXPR, void_type_node, null_mem, error, alloc); gfc_add_expr_to_block (block, tmp); diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index bcb466ffe8f..4579a80fe47 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -769,7 +769,7 @@ void gfc_allocate_using_caf_lib (stmtblock_t *, tree, tree, tree, tree, tree, void gfc_allocate_allocatable (stmtblock_t*, tree, tree, tree, tree, tree, tree, tree, gfc_expr*, int, tree = NULL_TREE, tree = NULL_TREE, - tree = NULL_TREE); + tree = NULL_TREE, tree = NULL_TREE); /* Allocate memory, with optional status variable. */ void gfc_allocate_using_malloc (stmtblock_t *, tree, tree, tree, diff --git a/gcc/testsuite/gfortran.dg/allocate_alloc_opt_16.f90 b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_16.f90 new file mode 100644 index 00000000000..cdcb27da5a4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_alloc_opt_16.f90 @@ -0,0 +1,53 @@ +! { dg-do run } +! { dg-additional-options "-O2" } +! +! PR fortran/128656 - ALLOCATE with STATUS and overflow of array size +! +! Reported by Henri Menke < henri at henrimenke.de > + +program gfortran_overflow_errmsg + use, intrinsic :: iso_c_binding, only: C_INTPTR_T + use, intrinsic :: iso_fortran_env, only: int64, real64 + implicit none + real(real64), allocatable :: a(:), b(:) + real(real64), pointer :: c(:), d(:) + integer(int64) :: n + integer :: stat1, stat2 + character(len=100) :: msg = "" + + n = huge (1_C_INTPTR_T) / 2 + 1 ! 2**62 for 64 bit, 2**30 for 32 bit + + ! allocate of unallocated variable with overflow of size calculated + ! gfortran could report a bogus "Attempt to allocate an allocated object" + allocate(a(n), stat=stat1, errmsg=msg) + + ! error code for "Insufficient virtual memory" + if (stat1 /= 5020) then + print '(a,i0,2a)', 'stat=', stat1, ' errmsg=', trim(msg) + stop 1 + end if + + allocate(c(n), stat=stat1, errmsg=msg) + if (stat1 /= 5020) then + print '(a,i0,2a)', 'stat=', stat1, ' errmsg=', trim(msg) + stop 2 + end if + + ! For pointers, there is no "already allocated variable" error + allocate(d(1)) + allocate(d(n), stat=stat2, errmsg=msg) + if (stat2 /= 5020) then + print '(a,i0,2a)', 'stat=', stat2, ' errmsg=', trim(msg) + stop 3 + end if + + allocate(b(1)) + ! allocate of already allocated variable: shall give appropriate error + allocate(b(n), stat=stat2, errmsg=msg) + + ! error code for "Attempt to allocate an allocated object" + if (stat2 /= 5014) then + print '(a,i0,2a)', 'stat=', stat2, ' errmsg=', trim(msg) + stop 4 + end if +end program gfortran_overflow_errmsg -- 2.51.0
