Harald,
I did a quick glance at the patch and did not see anything that
jumped out as needing a change. OK to commit.
Earlier today I came to the same conclusion that -1 on overflow is
probably the right thing to do. Gfortran would need a way to
supply the value of ERANGE (on all supported targets) so a
user can write a test. Yes, POSIX seems to define ERANGE as
34, but is that guaranteed on non-POSIX targets?
--
steve
On Sun, Jun 15, 2025 at 09:01:37PM +0200, Harald Anlauf wrote:
>
> here's a modification that returns -1 for those components of stat
> that would overflow assignment to integer(kind=4), and does not
> return ERANGE as in v1 of this patch. There is no need to modify
> the existing testcasese stat_{1,2}.f90.
>
> Cheers,
> Harald
>
> Am 12.06.25 um 22:12 schrieb Harald Anlauf:
> > Hi Steve,
> >
> > On 6/11/25 23:06, Steve Kargl wrote:
> > > On Wed, Jun 11, 2025 at 10:18:37PM +0200, Harald Anlauf wrote:
> > > > - for the INTEGER(KIND=4) versions the STATUS returns ERANGE if
> > > > an overflow is encountered.
> > > >
> > > > The latter is certainly debatable, as one of the existing testcases
> > > > stat_{1,2}.f90 may fail on systems where e.g. an inode number is larger
> > > > than INT32_MAX may occur. Options are to drop the overflow check, or
> > > > to run those testcases with additional option -fdefault-integer-8.
> > > >
> > > > Opinions?
> > > >
> >
> > another option is:
> >
> > - return -1 for components which overflow, and not return ERANGE,
> > thus to leave it up to the user to handle this
> >
> > It is arguably not an error generated by stat(3), but by the
> > interface to Fortran in the runtime.
> >
> > >
> > > Thanks for doing these types of cleanups.
> > >
> > > You may want to take a peek at
> > >
> > > https://gcc.gnu.org/bugzilla/show_bug.cgi?id=30372
> > >
> > > where I posted a few cleanups for SLEEP, UMASK, UNLINK,
> > > etc. In those cleanups, I would cast arguments to
> > > integer(4) if I could (ie., if I know the arg was in range)
> > > to prevent an explosion in the size of libgfortran.
> >
> > I do not plan to implement any new library versions. The
> > *_i4 and *_i8 versions are already available. All integer
> > arguments should be kind=4 or 8, and needed conversions
> > can be done using scalar temporaries.
> >
> > > I'll need to think about your -fdefault-integer-8 question
> > > for a bit. Because that option exists and can change
> > > default integer kind, we'll need *_i4 and *_i8 versions of
> > > the functions in libgfortran. I suspect we'll need to
> > > run the testcases with -fdefault-integer-8.
> >
> > This depends on the way we handle overflow. The variant
> > above would not need this option.
> >
> > > If no one approves your patch by Saturday, I'll review.
> >
> > Any helpful feedback is greatly appreciated.
> >
> > Thanks
> > Harald
> >
> >
> >
> From aa79324885ba44b64911ec7a75375b28a2223cf7 Mon Sep 17 00:00:00 2001
> From: Harald Anlauf <anl...@gmx.de>
> Date: Sun, 15 Jun 2025 20:47:13 +0200
> Subject: [PATCH] Fortran: various fixes for STAT/LSTAT/FSTAT intrinsics
> [PR82480]
>
> The GNU intrinsics STAT/LSTAT/FSTAT were inherited from g77, but changed
> the names of some keywords: FILE became NAME, and SARRAY became VALUES,
> which are the keywords documented in the gfortran manual.
> Adjust code and libgfortran error messages to reflect this change.
> Furthermore, add compile-time checking that INTENT(OUT) arguments are
> definable, and that array VALUES has at least size 13.
>
> PR fortran/82480
>
> gcc/fortran/ChangeLog:
>
> * check.cc (gfc_check_fstat): Extend checks to INTENT(OUT) arguments.
> (gfc_check_fstat_sub): Likewise.
> (gfc_check_stat): Likewise.
> (gfc_check_stat_sub): Likewise.
>
> libgfortran/ChangeLog:
>
> * intrinsics/stat.c (stat_i4_sub_0): Fix argument names. Rename
> SARRAY to VALUES also in error message. When array VALUES is
> KIND=4, get only stat components that do not overflow INT32_MAX,
> otherwise set the corresponding VALUES elements to -1.
> (stat_i4_sub): Fix argument names.
> (lstat_i4_sub): Likewise.
> (stat_i8_sub_0): Likewise.
> (stat_i8_sub): Likewise.
> (lstat_i8_sub): Likewise.
> (stat_i4): Likewise.
> (stat_i8): Likewise.
> (lstat_i4): Likewise.
> (lstat_i8): Likewise.
> (fstat_i4_sub): Likewise.
> (fstat_i8_sub): Likewise.
> (fstat_i4): Likewise.
> (fstat_i8): Likewise.
>
> gcc/testsuite/ChangeLog:
>
> * gfortran.dg/stat_3.f90: New test.
> ---
> gcc/fortran/check.cc | 61 +++---
> gcc/testsuite/gfortran.dg/stat_3.f90 | 46 +++++
> libgfortran/intrinsics/stat.c | 274 +++++++++++++++------------
> 3 files changed, 226 insertions(+), 155 deletions(-)
> create mode 100644 gcc/testsuite/gfortran.dg/stat_3.f90
>
> diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
> index c8904df3b21..838d523f7c4 100644
> --- a/gcc/fortran/check.cc
> +++ b/gcc/fortran/check.cc
> @@ -6507,7 +6507,7 @@ gfc_check_fseek_sub (gfc_expr *unit, gfc_expr *offset,
> gfc_expr *whence, gfc_exp
>
>
> bool
> -gfc_check_fstat (gfc_expr *unit, gfc_expr *array)
> +gfc_check_fstat (gfc_expr *unit, gfc_expr *values)
> {
> if (!type_check (unit, 0, BT_INTEGER))
> return false;
> @@ -6515,11 +6515,17 @@ gfc_check_fstat (gfc_expr *unit, gfc_expr *array)
> if (!scalar_check (unit, 0))
> return false;
>
> - if (!type_check (array, 1, BT_INTEGER)
> + if (!type_check (values, 1, BT_INTEGER)
> || !kind_value_check (unit, 0, gfc_default_integer_kind))
> return false;
>
> - if (!array_check (array, 1))
> + if (!array_check (values, 1))
> + return false;
> +
> + if (!variable_check (values, 1, false))
> + return false;
> +
> + if (!array_size_check (values, 1, 13))
> return false;
>
> return true;
> @@ -6527,19 +6533,9 @@ gfc_check_fstat (gfc_expr *unit, gfc_expr *array)
>
>
> bool
> -gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array, gfc_expr *status)
> +gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *values, gfc_expr *status)
> {
> - if (!type_check (unit, 0, BT_INTEGER))
> - return false;
> -
> - if (!scalar_check (unit, 0))
> - return false;
> -
> - if (!type_check (array, 1, BT_INTEGER)
> - || !kind_value_check (array, 1, gfc_default_integer_kind))
> - return false;
> -
> - if (!array_check (array, 1))
> + if (!gfc_check_fstat (unit, values))
> return false;
>
> if (status == NULL)
> @@ -6552,6 +6548,9 @@ gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *array,
> gfc_expr *status)
> if (!scalar_check (status, 2))
> return false;
>
> + if (!variable_check (status, 2, false))
> + return false;
> +
> return true;
> }
>
> @@ -6589,18 +6588,24 @@ gfc_check_ftell_sub (gfc_expr *unit, gfc_expr *offset)
>
>
> bool
> -gfc_check_stat (gfc_expr *name, gfc_expr *array)
> +gfc_check_stat (gfc_expr *name, gfc_expr *values)
> {
> if (!type_check (name, 0, BT_CHARACTER))
> return false;
> if (!kind_value_check (name, 0, gfc_default_character_kind))
> return false;
>
> - if (!type_check (array, 1, BT_INTEGER)
> - || !kind_value_check (array, 1, gfc_default_integer_kind))
> + if (!type_check (values, 1, BT_INTEGER)
> + || !kind_value_check (values, 1, gfc_default_integer_kind))
> return false;
>
> - if (!array_check (array, 1))
> + if (!array_check (values, 1))
> + return false;
> +
> + if (!variable_check (values, 1, false))
> + return false;
> +
> + if (!array_size_check (values, 1, 13))
> return false;
>
> return true;
> @@ -6608,30 +6613,24 @@ gfc_check_stat (gfc_expr *name, gfc_expr *array)
>
>
> bool
> -gfc_check_stat_sub (gfc_expr *name, gfc_expr *array, gfc_expr *status)
> +gfc_check_stat_sub (gfc_expr *name, gfc_expr *values, gfc_expr *status)
> {
> - if (!type_check (name, 0, BT_CHARACTER))
> - return false;
> - if (!kind_value_check (name, 0, gfc_default_character_kind))
> - return false;
> -
> - if (!type_check (array, 1, BT_INTEGER)
> - || !kind_value_check (array, 1, gfc_default_integer_kind))
> - return false;
> -
> - if (!array_check (array, 1))
> + if (!gfc_check_stat (name, values))
> return false;
>
> if (status == NULL)
> return true;
>
> if (!type_check (status, 2, BT_INTEGER)
> - || !kind_value_check (array, 1, gfc_default_integer_kind))
> + || !kind_value_check (status, 2, gfc_default_integer_kind))
> return false;
>
> if (!scalar_check (status, 2))
> return false;
>
> + if (!variable_check (status, 2, false))
> + return false;
> +
> return true;
> }
>
> diff --git a/gcc/testsuite/gfortran.dg/stat_3.f90
> b/gcc/testsuite/gfortran.dg/stat_3.f90
> new file mode 100644
> index 00000000000..93ec1836a9a
> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/stat_3.f90
> @@ -0,0 +1,46 @@
> +! { dg-do compile }
> +! PR fortran/82480 - checking of arguments to STAT/LSTAT/FSTAT
> +
> +subroutine sub1 ()
> + integer, parameter :: ik = kind(1)
> + integer(ik) :: buff12(12)
> + integer(ik) :: buff13(13)
> + integer(ik) :: unit = 10
> + integer(ik) :: ierr
> + character(len=64) :: name = "/etc/passwd"
> + ierr = stat (name, values= buff12) ! { dg-error "too small" }
> + ierr = stat (name, values= buff13)
> + ierr = lstat (name, values= buff12) ! { dg-error "too small" }
> + ierr = lstat (name, values= buff13)
> + ierr = fstat (unit, values= buff12) ! { dg-error "too small" }
> + ierr = fstat (unit, values= buff13)
> + ierr = stat (name, values=(buff13)) ! { dg-error "must be a variable" }
> + ierr = lstat (name, values=(buff13)) ! { dg-error "must be a variable" }
> + ierr = fstat (unit, values=(buff13)) ! { dg-error "must be a variable" }
> +end
> +
> +subroutine sub2 ()
> + integer, parameter :: ik = kind(1)
> + integer(ik) :: buff12(12)
> + integer(ik), target :: buff13(13) = 0
> + integer(ik) :: unit = 10
> + integer(ik), target :: ierr = 0
> + character(len=64) :: name = "/etc/passwd"
> + integer(ik),pointer :: pbuf(:) => buff13
> + integer(ik),pointer :: perr => ierr
> + call stat (name, status=ierr, values= buff12) ! { dg-error "too small" }
> + call stat (name, status=ierr, values= buff13)
> + call lstat (name, status=ierr, values= buff12) ! { dg-error "too small" }
> + call lstat (name, status=ierr, values= buff13)
> + call fstat (unit, status=ierr, values= buff12) ! { dg-error "too small" }
> + call fstat (unit, status=ierr, values= buff13)
> + call stat (name, status=ierr, values=(buff13)) ! { dg-error "must be a
> variable" }
> + call lstat (name, status=ierr, values=(buff13)) ! { dg-error "must be a
> variable" }
> + call fstat (unit, status=ierr, values=(buff13)) ! { dg-error "must be a
> variable" }
> + call stat (name, status=(ierr),values=buff13) ! { dg-error "must be a
> variable" }
> + call lstat (name, status=(ierr),values=buff13) ! { dg-error "must be a
> variable" }
> + call fstat (unit, status=(ierr),values=buff13) ! { dg-error "must be a
> variable" }
> + call stat (name, status=perr, values= pbuf)
> + call lstat (name, status=perr, values= pbuf)
> + call fstat (unit, status=perr, values= pbuf)
> +end
> diff --git a/libgfortran/intrinsics/stat.c b/libgfortran/intrinsics/stat.c
> index 8d32f223b24..63a57cd05ee 100644
> --- a/libgfortran/intrinsics/stat.c
> +++ b/libgfortran/intrinsics/stat.c
> @@ -35,22 +35,22 @@ see the files COPYING3 and COPYING.RUNTIME respectively.
> If not, see
>
> #ifdef HAVE_STAT
>
> -/* SUBROUTINE STAT(FILE, SARRAY, STATUS)
> +/* SUBROUTINE STAT(NAME, VALUES, STATUS)
> CHARACTER(len=*), INTENT(IN) :: FILE
> - INTEGER, INTENT(OUT), :: SARRAY(13)
> + INTEGER, INTENT(OUT), :: VALUES(13)
> INTEGER, INTENT(OUT), OPTIONAL :: STATUS
>
> - FUNCTION STAT(FILE, SARRAY)
> + FUNCTION STAT(NAME, VALUES)
> INTEGER STAT
> CHARACTER(len=*), INTENT(IN) :: FILE
> - INTEGER, INTENT(OUT), :: SARRAY(13) */
> + INTEGER, INTENT(OUT), :: VALUES(13) */
>
> /*extern void stat_i4_sub_0 (char *, gfc_array_i4 *, GFC_INTEGER_4 *,
> gfc_charlen_type, int);
> internal_proto(stat_i4_sub_0);*/
>
> static void
> -stat_i4_sub_0 (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
> +stat_i4_sub_0 (char *name, gfc_array_i4 *values, GFC_INTEGER_4 *status,
> gfc_charlen_type name_len, int is_lstat __attribute__ ((unused)))
> {
> int val;
> @@ -58,12 +58,12 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray,
> GFC_INTEGER_4 *status,
> struct stat sb;
>
> /* If the rank of the array is not 1, abort. */
> - if (GFC_DESCRIPTOR_RANK (sarray) != 1)
> - runtime_error ("Array rank of SARRAY is not 1.");
> + if (GFC_DESCRIPTOR_RANK (values) != 1)
> + runtime_error ("Array rank of VALUES is not 1.");
>
> /* If the array is too small, abort. */
> - if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
> - runtime_error ("Array size of SARRAY is too small.");
> + if (GFC_DESCRIPTOR_EXTENT(values,0) < 13)
> + runtime_error ("Array size of VALUES is too small.");
>
> /* Make a null terminated copy of the string. */
> str = fc_strdup (name, name_len);
> @@ -80,57 +80,70 @@ stat_i4_sub_0 (char *name, gfc_array_i4 *sarray,
> GFC_INTEGER_4 *status,
>
> if (val == 0)
> {
> - index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
> + index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
> +
> + /* Return -1 for any value overflowing INT32_MAX. */
> + for (int i = 0; i < 13; i++)
> + values->base_addr[i * stride] = -1;
>
> /* Device ID */
> - sarray->base_addr[0 * stride] = sb.st_dev;
> + if (sb.st_dev <= INT32_MAX)
> + values->base_addr[0 * stride] = sb.st_dev;
>
> /* Inode number */
> - sarray->base_addr[1 * stride] = sb.st_ino;
> + if (sb.st_ino <= INT32_MAX)
> + values->base_addr[1 * stride] = sb.st_ino;
>
> /* File mode */
> - sarray->base_addr[2 * stride] = sb.st_mode;
> + if (sb.st_mode <= INT32_MAX)
> + values->base_addr[2 * stride] = sb.st_mode;
>
> /* Number of (hard) links */
> - sarray->base_addr[3 * stride] = sb.st_nlink;
> + if (sb.st_nlink <= INT32_MAX)
> + values->base_addr[3 * stride] = sb.st_nlink;
>
> /* Owner's uid */
> - sarray->base_addr[4 * stride] = sb.st_uid;
> + if (sb.st_uid <= INT32_MAX)
> + values->base_addr[4 * stride] = sb.st_uid;
>
> /* Owner's gid */
> - sarray->base_addr[5 * stride] = sb.st_gid;
> + if (sb.st_gid <= INT32_MAX)
> + values->base_addr[5 * stride] = sb.st_gid;
>
> /* ID of device containing directory entry for file (0 if not
> available) */
> #if HAVE_STRUCT_STAT_ST_RDEV
> - sarray->base_addr[6 * stride] = sb.st_rdev;
> + if (sb.st_rdev <= INT32_MAX)
> + values->base_addr[6 * stride] = sb.st_rdev;
> #else
> - sarray->base_addr[6 * stride] = 0;
> + values->base_addr[6 * stride] = 0;
> #endif
>
> /* File size (bytes) */
> - sarray->base_addr[7 * stride] = sb.st_size;
> + if (sb.st_size <= INT32_MAX)
> + values->base_addr[7 * stride] = sb.st_size;
>
> /* Last access time */
> - sarray->base_addr[8 * stride] = sb.st_atime;
> + if (sb.st_atime <= INT32_MAX)
> + values->base_addr[8 * stride] = sb.st_atime;
>
> /* Last modification time */
> - sarray->base_addr[9 * stride] = sb.st_mtime;
> + if (sb.st_mtime <= INT32_MAX)
> + values->base_addr[9 * stride] = sb.st_mtime;
>
> /* Last file status change time */
> - sarray->base_addr[10 * stride] = sb.st_ctime;
> + if (sb.st_ctime <= INT32_MAX)
> + values->base_addr[10 * stride] = sb.st_ctime;
>
> /* Preferred I/O block size (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLKSIZE
> - sarray->base_addr[11 * stride] = sb.st_blksize;
> -#else
> - sarray->base_addr[11 * stride] = -1;
> + if (sb.st_blksize <= INT32_MAX)
> + values->base_addr[11 * stride] = sb.st_blksize;
> #endif
>
> /* Number of blocks allocated (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLOCKS
> - sarray->base_addr[12 * stride] = sb.st_blocks;
> -#else
> - sarray->base_addr[12 * stride] = -1;
> + if (sb.st_blocks <= INT32_MAX)
> + values->base_addr[12 * stride] = sb.st_blocks;
> #endif
> }
>
> @@ -144,10 +157,10 @@ extern void stat_i4_sub (char *, gfc_array_i4 *,
> GFC_INTEGER_4 *,
> iexport_proto(stat_i4_sub);
>
> void
> -stat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
> +stat_i4_sub (char *name, gfc_array_i4 *values, GFC_INTEGER_4 *status,
> gfc_charlen_type name_len)
> {
> - stat_i4_sub_0 (name, sarray, status, name_len, 0);
> + stat_i4_sub_0 (name, values, status, name_len, 0);
> }
> iexport(stat_i4_sub);
>
> @@ -157,17 +170,17 @@ extern void lstat_i4_sub (char *, gfc_array_i4 *,
> GFC_INTEGER_4 *,
> iexport_proto(lstat_i4_sub);
>
> void
> -lstat_i4_sub (char *name, gfc_array_i4 *sarray, GFC_INTEGER_4 *status,
> +lstat_i4_sub (char *name, gfc_array_i4 *values, GFC_INTEGER_4 *status,
> gfc_charlen_type name_len)
> {
> - stat_i4_sub_0 (name, sarray, status, name_len, 1);
> + stat_i4_sub_0 (name, values, status, name_len, 1);
> }
> iexport(lstat_i4_sub);
>
>
>
> static void
> -stat_i8_sub_0 (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
> +stat_i8_sub_0 (char *name, gfc_array_i8 *values, GFC_INTEGER_8 *status,
> gfc_charlen_type name_len, int is_lstat __attribute__ ((unused)))
> {
> int val;
> @@ -175,12 +188,12 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray,
> GFC_INTEGER_8 *status,
> struct stat sb;
>
> /* If the rank of the array is not 1, abort. */
> - if (GFC_DESCRIPTOR_RANK (sarray) != 1)
> - runtime_error ("Array rank of SARRAY is not 1.");
> + if (GFC_DESCRIPTOR_RANK (values) != 1)
> + runtime_error ("Array rank of VALUES is not 1.");
>
> /* If the array is too small, abort. */
> - if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
> - runtime_error ("Array size of SARRAY is too small.");
> + if (GFC_DESCRIPTOR_EXTENT(values,0) < 13)
> + runtime_error ("Array size of VALUES is too small.");
>
> /* Make a null terminated copy of the string. */
> str = fc_strdup (name, name_len);
> @@ -197,57 +210,57 @@ stat_i8_sub_0 (char *name, gfc_array_i8 *sarray,
> GFC_INTEGER_8 *status,
>
> if (val == 0)
> {
> - index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
> + index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
>
> /* Device ID */
> - sarray->base_addr[0] = sb.st_dev;
> + values->base_addr[0] = sb.st_dev;
>
> /* Inode number */
> - sarray->base_addr[stride] = sb.st_ino;
> + values->base_addr[stride] = sb.st_ino;
>
> /* File mode */
> - sarray->base_addr[2 * stride] = sb.st_mode;
> + values->base_addr[2 * stride] = sb.st_mode;
>
> /* Number of (hard) links */
> - sarray->base_addr[3 * stride] = sb.st_nlink;
> + values->base_addr[3 * stride] = sb.st_nlink;
>
> /* Owner's uid */
> - sarray->base_addr[4 * stride] = sb.st_uid;
> + values->base_addr[4 * stride] = sb.st_uid;
>
> /* Owner's gid */
> - sarray->base_addr[5 * stride] = sb.st_gid;
> + values->base_addr[5 * stride] = sb.st_gid;
>
> /* ID of device containing directory entry for file (0 if not
> available) */
> #if HAVE_STRUCT_STAT_ST_RDEV
> - sarray->base_addr[6 * stride] = sb.st_rdev;
> + values->base_addr[6 * stride] = sb.st_rdev;
> #else
> - sarray->base_addr[6 * stride] = 0;
> + values->base_addr[6 * stride] = 0;
> #endif
>
> /* File size (bytes) */
> - sarray->base_addr[7 * stride] = sb.st_size;
> + values->base_addr[7 * stride] = sb.st_size;
>
> /* Last access time */
> - sarray->base_addr[8 * stride] = sb.st_atime;
> + values->base_addr[8 * stride] = sb.st_atime;
>
> /* Last modification time */
> - sarray->base_addr[9 * stride] = sb.st_mtime;
> + values->base_addr[9 * stride] = sb.st_mtime;
>
> /* Last file status change time */
> - sarray->base_addr[10 * stride] = sb.st_ctime;
> + values->base_addr[10 * stride] = sb.st_ctime;
>
> /* Preferred I/O block size (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLKSIZE
> - sarray->base_addr[11 * stride] = sb.st_blksize;
> + values->base_addr[11 * stride] = sb.st_blksize;
> #else
> - sarray->base_addr[11 * stride] = -1;
> + values->base_addr[11 * stride] = -1;
> #endif
>
> /* Number of blocks allocated (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLOCKS
> - sarray->base_addr[12 * stride] = sb.st_blocks;
> + values->base_addr[12 * stride] = sb.st_blocks;
> #else
> - sarray->base_addr[12 * stride] = -1;
> + values->base_addr[12 * stride] = -1;
> #endif
> }
>
> @@ -261,10 +274,10 @@ extern void stat_i8_sub (char *, gfc_array_i8 *,
> GFC_INTEGER_8 *,
> iexport_proto(stat_i8_sub);
>
> void
> -stat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
> +stat_i8_sub (char *name, gfc_array_i8 *values, GFC_INTEGER_8 *status,
> gfc_charlen_type name_len)
> {
> - stat_i8_sub_0 (name, sarray, status, name_len, 0);
> + stat_i8_sub_0 (name, values, status, name_len, 0);
> }
>
> iexport(stat_i8_sub);
> @@ -275,10 +288,10 @@ extern void lstat_i8_sub (char *, gfc_array_i8 *,
> GFC_INTEGER_8 *,
> iexport_proto(lstat_i8_sub);
>
> void
> -lstat_i8_sub (char *name, gfc_array_i8 *sarray, GFC_INTEGER_8 *status,
> +lstat_i8_sub (char *name, gfc_array_i8 *values, GFC_INTEGER_8 *status,
> gfc_charlen_type name_len)
> {
> - stat_i8_sub_0 (name, sarray, status, name_len, 1);
> + stat_i8_sub_0 (name, values, status, name_len, 1);
> }
>
> iexport(lstat_i8_sub);
> @@ -288,10 +301,10 @@ extern GFC_INTEGER_4 stat_i4 (char *, gfc_array_i4 *,
> gfc_charlen_type);
> export_proto(stat_i4);
>
> GFC_INTEGER_4
> -stat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len)
> +stat_i4 (char *name, gfc_array_i4 *values, gfc_charlen_type name_len)
> {
> GFC_INTEGER_4 val;
> - stat_i4_sub (name, sarray, &val, name_len);
> + stat_i4_sub (name, values, &val, name_len);
> return val;
> }
>
> @@ -299,32 +312,32 @@ extern GFC_INTEGER_8 stat_i8 (char *, gfc_array_i8 *,
> gfc_charlen_type);
> export_proto(stat_i8);
>
> GFC_INTEGER_8
> -stat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len)
> +stat_i8 (char *name, gfc_array_i8 *values, gfc_charlen_type name_len)
> {
> GFC_INTEGER_8 val;
> - stat_i8_sub (name, sarray, &val, name_len);
> + stat_i8_sub (name, values, &val, name_len);
> return val;
> }
>
>
> -/* SUBROUTINE LSTAT(FILE, SARRAY, STATUS)
> +/* SUBROUTINE LSTAT(NAME, VALUES, STATUS)
> CHARACTER(len=*), INTENT(IN) :: FILE
> - INTEGER, INTENT(OUT), :: SARRAY(13)
> + INTEGER, INTENT(OUT), :: VALUES(13)
> INTEGER, INTENT(OUT), OPTIONAL :: STATUS
>
> - FUNCTION LSTAT(FILE, SARRAY)
> + FUNCTION LSTAT(NAME, VALUES)
> INTEGER LSTAT
> CHARACTER(len=*), INTENT(IN) :: FILE
> - INTEGER, INTENT(OUT), :: SARRAY(13) */
> + INTEGER, INTENT(OUT), :: VALUES(13) */
>
> extern GFC_INTEGER_4 lstat_i4 (char *, gfc_array_i4 *, gfc_charlen_type);
> export_proto(lstat_i4);
>
> GFC_INTEGER_4
> -lstat_i4 (char *name, gfc_array_i4 *sarray, gfc_charlen_type name_len)
> +lstat_i4 (char *name, gfc_array_i4 *values, gfc_charlen_type name_len)
> {
> GFC_INTEGER_4 val;
> - lstat_i4_sub (name, sarray, &val, name_len);
> + lstat_i4_sub (name, values, &val, name_len);
> return val;
> }
>
> @@ -332,10 +345,10 @@ extern GFC_INTEGER_8 lstat_i8 (char *, gfc_array_i8 *,
> gfc_charlen_type);
> export_proto(lstat_i8);
>
> GFC_INTEGER_8
> -lstat_i8 (char *name, gfc_array_i8 *sarray, gfc_charlen_type name_len)
> +lstat_i8 (char *name, gfc_array_i8 *values, gfc_charlen_type name_len)
> {
> GFC_INTEGER_8 val;
> - lstat_i8_sub (name, sarray, &val, name_len);
> + lstat_i8_sub (name, values, &val, name_len);
> return val;
> }
>
> @@ -344,32 +357,32 @@ lstat_i8 (char *name, gfc_array_i8 *sarray,
> gfc_charlen_type name_len)
>
> #ifdef HAVE_FSTAT
>
> -/* SUBROUTINE FSTAT(UNIT, SARRAY, STATUS)
> +/* SUBROUTINE FSTAT(UNIT, VALUES, STATUS)
> INTEGER, INTENT(IN) :: UNIT
> - INTEGER, INTENT(OUT) :: SARRAY(13)
> + INTEGER, INTENT(OUT) :: VALUES(13)
> INTEGER, INTENT(OUT), OPTIONAL :: STATUS
>
> - FUNCTION FSTAT(UNIT, SARRAY)
> + FUNCTION FSTAT(UNIT, VALUES)
> INTEGER FSTAT
> INTEGER, INTENT(IN) :: UNIT
> - INTEGER, INTENT(OUT) :: SARRAY(13) */
> + INTEGER, INTENT(OUT) :: VALUES(13) */
>
> extern void fstat_i4_sub (GFC_INTEGER_4 *, gfc_array_i4 *, GFC_INTEGER_4 *);
> iexport_proto(fstat_i4_sub);
>
> void
> -fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray, GFC_INTEGER_4
> *status)
> +fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4 *values, GFC_INTEGER_4
> *status)
> {
> int val;
> struct stat sb;
>
> /* If the rank of the array is not 1, abort. */
> - if (GFC_DESCRIPTOR_RANK (sarray) != 1)
> - runtime_error ("Array rank of SARRAY is not 1.");
> + if (GFC_DESCRIPTOR_RANK (values) != 1)
> + runtime_error ("Array rank of VALUES is not 1.");
>
> /* If the array is too small, abort. */
> - if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
> - runtime_error ("Array size of SARRAY is too small.");
> + if (GFC_DESCRIPTOR_EXTENT(values,0) < 13)
> + runtime_error ("Array size of VALUES is too small.");
>
> /* Convert Fortran unit number to C file descriptor. */
> val = unit_to_fd (*unit);
> @@ -378,57 +391,70 @@ fstat_i4_sub (GFC_INTEGER_4 *unit, gfc_array_i4
> *sarray, GFC_INTEGER_4 *status)
>
> if (val == 0)
> {
> - index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
> + index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
> +
> + /* Return -1 for any value overflowing INT32_MAX. */
> + for (int i = 0; i < 13; i++)
> + values->base_addr[i * stride] = -1;
>
> /* Device ID */
> - sarray->base_addr[0 * stride] = sb.st_dev;
> + if (sb.st_dev <= INT32_MAX)
> + values->base_addr[0 * stride] = sb.st_dev;
>
> /* Inode number */
> - sarray->base_addr[1 * stride] = sb.st_ino;
> + if (sb.st_ino <= INT32_MAX)
> + values->base_addr[1 * stride] = sb.st_ino;
>
> /* File mode */
> - sarray->base_addr[2 * stride] = sb.st_mode;
> + if (sb.st_mode <= INT32_MAX)
> + values->base_addr[2 * stride] = sb.st_mode;
>
> /* Number of (hard) links */
> - sarray->base_addr[3 * stride] = sb.st_nlink;
> + if (sb.st_nlink <= INT32_MAX)
> + values->base_addr[3 * stride] = sb.st_nlink;
>
> /* Owner's uid */
> - sarray->base_addr[4 * stride] = sb.st_uid;
> + if (sb.st_uid <= INT32_MAX)
> + values->base_addr[4 * stride] = sb.st_uid;
>
> /* Owner's gid */
> - sarray->base_addr[5 * stride] = sb.st_gid;
> + if (sb.st_gid <= INT32_MAX)
> + values->base_addr[5 * stride] = sb.st_gid;
>
> /* ID of device containing directory entry for file (0 if not
> available) */
> #if HAVE_STRUCT_STAT_ST_RDEV
> - sarray->base_addr[6 * stride] = sb.st_rdev;
> + if (sb.st_rdev <= INT32_MAX)
> + values->base_addr[6 * stride] = sb.st_rdev;
> #else
> - sarray->base_addr[6 * stride] = 0;
> + values->base_addr[6 * stride] = 0;
> #endif
>
> /* File size (bytes) */
> - sarray->base_addr[7 * stride] = sb.st_size;
> + if (sb.st_size <= INT32_MAX)
> + values->base_addr[7 * stride] = sb.st_size;
>
> /* Last access time */
> - sarray->base_addr[8 * stride] = sb.st_atime;
> + if (sb.st_atime <= INT32_MAX)
> + values->base_addr[8 * stride] = sb.st_atime;
>
> /* Last modification time */
> - sarray->base_addr[9 * stride] = sb.st_mtime;
> + if (sb.st_mtime <= INT32_MAX)
> + values->base_addr[9 * stride] = sb.st_mtime;
>
> /* Last file status change time */
> - sarray->base_addr[10 * stride] = sb.st_ctime;
> + if (sb.st_ctime <= INT32_MAX)
> + values->base_addr[10 * stride] = sb.st_ctime;
>
> /* Preferred I/O block size (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLKSIZE
> - sarray->base_addr[11 * stride] = sb.st_blksize;
> -#else
> - sarray->base_addr[11 * stride] = -1;
> + if (sb.st_blksize <= INT32_MAX)
> + values->base_addr[11 * stride] = sb.st_blksize;
> #endif
>
> /* Number of blocks allocated (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLOCKS
> - sarray->base_addr[12 * stride] = sb.st_blocks;
> -#else
> - sarray->base_addr[12 * stride] = -1;
> + if (sb.st_blocks <= INT32_MAX)
> + values->base_addr[12 * stride] = sb.st_blocks;
> #endif
> }
>
> @@ -441,18 +467,18 @@ extern void fstat_i8_sub (GFC_INTEGER_8 *, gfc_array_i8
> *, GFC_INTEGER_8 *);
> iexport_proto(fstat_i8_sub);
>
> void
> -fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray, GFC_INTEGER_8
> *status)
> +fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8 *values, GFC_INTEGER_8
> *status)
> {
> int val;
> struct stat sb;
>
> /* If the rank of the array is not 1, abort. */
> - if (GFC_DESCRIPTOR_RANK (sarray) != 1)
> - runtime_error ("Array rank of SARRAY is not 1.");
> + if (GFC_DESCRIPTOR_RANK (values) != 1)
> + runtime_error ("Array rank of VALUES is not 1.");
>
> /* If the array is too small, abort. */
> - if (GFC_DESCRIPTOR_EXTENT(sarray,0) < 13)
> - runtime_error ("Array size of SARRAY is too small.");
> + if (GFC_DESCRIPTOR_EXTENT(values,0) < 13)
> + runtime_error ("Array size of VALUES is too small.");
>
> /* Convert Fortran unit number to C file descriptor. */
> val = unit_to_fd ((int) *unit);
> @@ -461,57 +487,57 @@ fstat_i8_sub (GFC_INTEGER_8 *unit, gfc_array_i8
> *sarray, GFC_INTEGER_8 *status)
>
> if (val == 0)
> {
> - index_type stride = GFC_DESCRIPTOR_STRIDE(sarray,0);
> + index_type stride = GFC_DESCRIPTOR_STRIDE(values,0);
>
> /* Device ID */
> - sarray->base_addr[0] = sb.st_dev;
> + values->base_addr[0] = sb.st_dev;
>
> /* Inode number */
> - sarray->base_addr[stride] = sb.st_ino;
> + values->base_addr[stride] = sb.st_ino;
>
> /* File mode */
> - sarray->base_addr[2 * stride] = sb.st_mode;
> + values->base_addr[2 * stride] = sb.st_mode;
>
> /* Number of (hard) links */
> - sarray->base_addr[3 * stride] = sb.st_nlink;
> + values->base_addr[3 * stride] = sb.st_nlink;
>
> /* Owner's uid */
> - sarray->base_addr[4 * stride] = sb.st_uid;
> + values->base_addr[4 * stride] = sb.st_uid;
>
> /* Owner's gid */
> - sarray->base_addr[5 * stride] = sb.st_gid;
> + values->base_addr[5 * stride] = sb.st_gid;
>
> /* ID of device containing directory entry for file (0 if not
> available) */
> #if HAVE_STRUCT_STAT_ST_RDEV
> - sarray->base_addr[6 * stride] = sb.st_rdev;
> + values->base_addr[6 * stride] = sb.st_rdev;
> #else
> - sarray->base_addr[6 * stride] = 0;
> + values->base_addr[6 * stride] = 0;
> #endif
>
> /* File size (bytes) */
> - sarray->base_addr[7 * stride] = sb.st_size;
> + values->base_addr[7 * stride] = sb.st_size;
>
> /* Last access time */
> - sarray->base_addr[8 * stride] = sb.st_atime;
> + values->base_addr[8 * stride] = sb.st_atime;
>
> /* Last modification time */
> - sarray->base_addr[9 * stride] = sb.st_mtime;
> + values->base_addr[9 * stride] = sb.st_mtime;
>
> /* Last file status change time */
> - sarray->base_addr[10 * stride] = sb.st_ctime;
> + values->base_addr[10 * stride] = sb.st_ctime;
>
> /* Preferred I/O block size (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLKSIZE
> - sarray->base_addr[11 * stride] = sb.st_blksize;
> + values->base_addr[11 * stride] = sb.st_blksize;
> #else
> - sarray->base_addr[11 * stride] = -1;
> + values->base_addr[11 * stride] = -1;
> #endif
>
> /* Number of blocks allocated (-1 if not available) */
> #if HAVE_STRUCT_STAT_ST_BLOCKS
> - sarray->base_addr[12 * stride] = sb.st_blocks;
> + values->base_addr[12 * stride] = sb.st_blocks;
> #else
> - sarray->base_addr[12 * stride] = -1;
> + values->base_addr[12 * stride] = -1;
> #endif
> }
>
> @@ -524,10 +550,10 @@ extern GFC_INTEGER_4 fstat_i4 (GFC_INTEGER_4 *,
> gfc_array_i4 *);
> export_proto(fstat_i4);
>
> GFC_INTEGER_4
> -fstat_i4 (GFC_INTEGER_4 *unit, gfc_array_i4 *sarray)
> +fstat_i4 (GFC_INTEGER_4 *unit, gfc_array_i4 *values)
> {
> GFC_INTEGER_4 val;
> - fstat_i4_sub (unit, sarray, &val);
> + fstat_i4_sub (unit, values, &val);
> return val;
> }
>
> @@ -535,10 +561,10 @@ extern GFC_INTEGER_8 fstat_i8 (GFC_INTEGER_8 *,
> gfc_array_i8 *);
> export_proto(fstat_i8);
>
> GFC_INTEGER_8
> -fstat_i8 (GFC_INTEGER_8 *unit, gfc_array_i8 *sarray)
> +fstat_i8 (GFC_INTEGER_8 *unit, gfc_array_i8 *values)
> {
> GFC_INTEGER_8 val;
> - fstat_i8_sub (unit, sarray, &val);
> + fstat_i8_sub (unit, values, &val);
> return val;
> }
>
> --
> 2.43.0
>
--
Steve
