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.
Document that integer arguments are of default kind, and that overflows
in conversion to integer return -1 in VALUES.

	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.
	* intrinsic.texi: Adjust documentation.

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.

diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index c8904df3b21c3afbc69f41c84dee0c583a31aac7..838d523f7c4063c22e91ee51c43cc3baf199a87c 100644 (file)
--- 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/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 583199564e4b74ad2f332c8f3a593a65b7f701ff..3103da3da093fdb04e1a6f34c1080bcefaf62ea6 100644 (file)
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -7001,9 +7001,11 @@ Subroutine, function
 @item @emph{Arguments}:
 @multitable @columnfractions .15 .70
 @item @var{UNIT}   @tab An open I/O unit number of type @code{INTEGER}.
-@item @var{VALUES} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 
-on success and a system specific error code otherwise.
+@item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(13)}
+of the default kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}
+of the default kind.
+Returns 0 on success and a system specific error code otherwise.
 @end multitable
 
 @item @emph{Example}:
@@ -10306,8 +10308,10 @@ Subroutine, function
 @multitable @columnfractions .15 .70
 @item @var{NAME}   @tab The type shall be @code{CHARACTER} of the default
 kind, a valid path within the file system.
-@item @var{VALUES} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}.
+@item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(13)}
+of the default kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}
+of the default kind.
 Returns 0 on success and a system specific error code otherwise.
 @end multitable
 
@@ -14391,6 +14395,8 @@ The elements that are obtained and stored in the array @code{VALUES}:
 
 Not all these elements are relevant on all systems. 
 If an element is not relevant, it is returned as 0.
+If the value of an element would overflow the range of default integer,
+a -1 is returned instead.
 
 This intrinsic is provided in both subroutine and function forms; however,
 only one form can be used in any given program unit.
@@ -14402,9 +14408,11 @@ Subroutine, function
 @multitable @columnfractions .15 .70
 @item @var{NAME}   @tab The type shall be @code{CHARACTER}, of the
 default kind and a valid path within the file system.
-@item @var{VALUES} @tab The type shall be @code{INTEGER(4), DIMENSION(13)}.
-@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER(4)}. Returns 0 
-on success and a system specific error code otherwise.
+@item @var{VALUES} @tab The type shall be @code{INTEGER, DIMENSION(13)}
+of the default kind.
+@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}
+of the default kind.
+Returns 0 on success and a system specific error code otherwise.
 @end multitable
 
 @item @emph{Example}:

diff --git a/gcc/testsuite/gfortran.dg/stat_3.f90 b/gcc/testsuite/gfortran.dg/stat_3.f90
new file mode 100644 (file)
index 0000000..93ec183
--- /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 8d32f223b24fc9854d6b6376338e642720bf65d6..63a57cd05eecfd7304dacb3993b4db0308efe405 100644 (file)
--- 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;
 }