Dear all,
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
