Dear all,
this is the second (and hopefully final) patch to fix this PR for good.
This makes the GNU intrinsics STAT/LSTAT/FSTAT almost generic, with few
restrictions:
- for the VALUES argument we will support only kinds 4 and 8.
This allows to stay with the current runtime library functions
in libgfortran. Other arguments will be converted suitably.
- a STATUS argument shall have a decimal exponent range of at
least four. This allows to handle both common errno values
as well as potential LIBERROR_* from libgfortran.h.
The hard part was getting this optional,intent(out) STATUS
argument right when we want to allow kind conversions,
and the actual argument being an optional dummy.
In its current version, gfc_conv_procedure_call does not seem
to support such trickery, so I wrote a specialized version
handling this. It is actually more complex than it needs
to be, as the related runtime library functions do not
change their behavior depending on the presence of the
actual argument. We'll generate a temporary of the needed
kind, pass a suitable pointer, and assign the result only
when it should happen.
(Maybe the required feature is already mostly implemented,
but I just did not see it.)
Regtested on x86_64-pc-linux-gnu. OK for mainline?
Thanks,
Harald
From 37a01654fba38124b36fe37458d99f373a52d67d Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Mon, 8 Sep 2025 21:21:15 +0200
Subject: [PATCH] Fortran: make STAT/LSTAT/FSTAT intrinsics generic [PR82480]
PR fortran/82480
gcc/fortran/ChangeLog:
* check.cc (error_unsupported_kind): Helper function to report an
unsupported kind of an argument.
(check_minrange4): Helper function to report if an integer variable
does not have a decimal range of at least four.
(gfc_check_fstat): Adjust checks for generalization of instrinsic
function FSTAT.
(gfc_check_fstat_sub): Likewise for subroutine FSTAT.
(gfc_check_stat): Likewise for functio STAT.
(gfc_check_stat_sub): Likewise for subroutine STAT.
* intrinsic.texi: Document generalized versions of intrinsics
STAT/LSTAT/FSTAT.
* iresolve.cc (gfc_resolve_stat): STAT function result shall have
the same kind as the VALUES argument.
(gfc_resolve_lstat): Likewise for LSTAT.
(gfc_resolve_fstat): Likewise for FSTAT.
(gfc_resolve_stat_sub): Resolve proper library subroutine for STAT.
(gfc_resolve_lstat_sub): Likewise for LSTAT.
* trans-decl.cc (gfc_build_intrinsic_function_decls): Declare
fndecls for required subroutines in runtine library.
* trans-intrinsic.cc (conv_intrinsic_fstat_lstat_stat_sub): Emit
runtime wrapper code for the library functions, taking care of
possible kind conversion of the optional STATUS argument of the
subroutine versions of the intrinsics.
(gfc_conv_intrinsic_subroutine): Use it.
* trans.h (GTY): Declare prototypes.
gcc/testsuite/ChangeLog:
* gfortran.dg/stat_3.f90: Extend argument checking.
* gfortran.dg/stat_4.f90: New test.
---
gcc/fortran/check.cc | 52 +++++++++--
gcc/fortran/intrinsic.texi | 44 +++++-----
gcc/fortran/iresolve.cc | 22 ++---
gcc/fortran/trans-decl.cc | 34 ++++++++
gcc/fortran/trans-intrinsic.cc | 125 +++++++++++++++++++++++++++
gcc/fortran/trans.h | 6 ++
gcc/testsuite/gfortran.dg/stat_3.f90 | 13 +++
gcc/testsuite/gfortran.dg/stat_4.f90 | 94 ++++++++++++++++++++
8 files changed, 352 insertions(+), 38 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/stat_4.f90
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index 80aac89c333..1f170131ae1 100644
--- a/gcc/fortran/check.cc
+++ b/gcc/fortran/check.cc
@@ -1107,6 +1107,36 @@ kind_value_check (gfc_expr *e, int n, int k)
}
+/* Error message for an actual argument with an unsupported kind value. */
+
+static void
+error_unsupported_kind (gfc_expr *e, int n)
+{
+ gfc_error ("Not supported: %qs argument of %qs intrinsic at %L with kind %d",
+ gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where, e->ts.kind);
+ return;
+}
+
+
+/* Check if the decimal exponent range of an integer variable is at least four
+ so that it is large enough to e.g. hold errno values and the values of
+ LIBERROR_* from libgfortran.h. */
+
+static bool
+check_minrange4 (gfc_expr *e, int n)
+{
+ if (e->ts.kind >= 2)
+ return true;
+
+ gfc_error ("%qs argument of %qs intrinsic at %L must have "
+ "a decimal exponent range of at least four",
+ gfc_current_intrinsic_arg[n]->name,
+ gfc_current_intrinsic, &e->where);
+ return false;
+}
+
+
/* Make sure an expression is a variable. */
static bool
@@ -6574,10 +6604,15 @@ gfc_check_fstat (gfc_expr *unit, gfc_expr *values)
if (!scalar_check (unit, 0))
return false;
- if (!type_check (values, 1, BT_INTEGER)
- || !kind_value_check (unit, 0, gfc_default_integer_kind))
+ if (!type_check (values, 1, BT_INTEGER))
return false;
+ if (values->ts.kind != 4 && values->ts.kind != 8)
+ {
+ error_unsupported_kind (values, 1);
+ return false;
+ }
+
if (!array_check (values, 1))
return false;
@@ -6601,7 +6636,7 @@ gfc_check_fstat_sub (gfc_expr *unit, gfc_expr *values, gfc_expr *status)
return true;
if (!type_check (status, 2, BT_INTEGER)
- || !kind_value_check (status, 2, gfc_default_integer_kind))
+ || !check_minrange4 (status, 2))
return false;
if (!scalar_check (status, 2))
@@ -6654,10 +6689,15 @@ gfc_check_stat (gfc_expr *name, gfc_expr *values)
if (!kind_value_check (name, 0, gfc_default_character_kind))
return false;
- if (!type_check (values, 1, BT_INTEGER)
- || !kind_value_check (values, 1, gfc_default_integer_kind))
+ if (!type_check (values, 1, BT_INTEGER))
return false;
+ if (values->ts.kind != 4 && values->ts.kind != 8)
+ {
+ error_unsupported_kind (values, 1);
+ return false;
+ }
+
if (!array_check (values, 1))
return false;
@@ -6681,7 +6721,7 @@ gfc_check_stat_sub (gfc_expr *name, gfc_expr *values, gfc_expr *status)
return true;
if (!type_check (status, 2, BT_INTEGER)
- || !kind_value_check (status, 2, gfc_default_integer_kind))
+ || !check_minrange4 (status, 2))
return false;
if (!scalar_check (status, 2))
diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 6b9f4cd809a..9012c2a5746 100644
--- a/gcc/fortran/intrinsic.texi
+++ b/gcc/fortran/intrinsic.texi
@@ -6992,7 +6992,7 @@ GNU extension
@end multitable
@item @emph{Description}:
-@code{FSTAT} is identical to @ref{STAT}, except that information about an
+@code{FSTAT} is identical to @ref{STAT}, except that information about an
already opened file is obtained.
The elements in @code{VALUES} are the same as described by @ref{STAT}.
@@ -7007,9 +7007,9 @@ Subroutine, function
@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, DIMENSION(13)}
-of the default kind.
+of either kind 4 or kind 8.
@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}
-of the default kind.
+of kind 2 or larger.
Returns 0 on success and a system specific error code otherwise.
@end multitable
@@ -10314,9 +10314,9 @@ Subroutine, function
@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, DIMENSION(13)}
-of the default kind.
+of either kind 4 or kind 8.
@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}
-of the default kind.
+of kind 2 or larger.
Returns 0 on success and a system specific error code otherwise.
@end multitable
@@ -14440,28 +14440,28 @@ GNU extension
@end multitable
@item @emph{Description}:
-This function returns information about a file. No permissions are required on
-the file itself, but execute (search) permission is required on all of the
+This function returns information about a file. No permissions are required on
+the file itself, but execute (search) permission is required on all of the
directories in path that lead to the file.
The elements that are obtained and stored in the array @code{VALUES}:
@multitable @columnfractions .15 .70
-@item @code{VALUES(1)} @tab Device ID
-@item @code{VALUES(2)} @tab Inode number
-@item @code{VALUES(3)} @tab File mode
-@item @code{VALUES(4)} @tab Number of links
-@item @code{VALUES(5)} @tab Owner's uid
-@item @code{VALUES(6)} @tab Owner's gid
-@item @code{VALUES(7)} @tab ID of device containing directory entry for file (0 if not available)
-@item @code{VALUES(8)} @tab File size (bytes)
-@item @code{VALUES(9)} @tab Last access time
-@item @code{VALUES(10)} @tab Last modification time
-@item @code{VALUES(11)} @tab Last file status change time
-@item @code{VALUES(12)} @tab Preferred I/O block size (-1 if not available)
+@item @code{VALUES(1)} @tab Device ID
+@item @code{VALUES(2)} @tab Inode number
+@item @code{VALUES(3)} @tab File mode
+@item @code{VALUES(4)} @tab Number of links
+@item @code{VALUES(5)} @tab Owner's uid
+@item @code{VALUES(6)} @tab Owner's gid
+@item @code{VALUES(7)} @tab ID of device containing directory entry for file (0 if not available)
+@item @code{VALUES(8)} @tab File size (bytes)
+@item @code{VALUES(9)} @tab Last access time
+@item @code{VALUES(10)} @tab Last modification time
+@item @code{VALUES(11)} @tab Last file status change time
+@item @code{VALUES(12)} @tab Preferred I/O block size (-1 if not available)
@item @code{VALUES(13)} @tab Number of blocks allocated (-1 if not available)
@end multitable
-Not all these elements are relevant on all systems.
+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.
@@ -14477,9 +14477,9 @@ Subroutine, function
@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, DIMENSION(13)}
-of the default kind.
+of either kind 4 or kind 8.
@item @var{STATUS} @tab (Optional) status flag of type @code{INTEGER}
-of the default kind.
+of kind 2 or larger.
Returns 0 on success and a system specific error code otherwise.
@end multitable
diff --git a/gcc/fortran/iresolve.cc b/gcc/fortran/iresolve.cc
index da354ab5056..a821332ecb2 100644
--- a/gcc/fortran/iresolve.cc
+++ b/gcc/fortran/iresolve.cc
@@ -3000,30 +3000,28 @@ gfc_resolve_sqrt (gfc_expr *f, gfc_expr *x)
/* Resolve the g77 compatibility function STAT AND FSTAT. */
void
-gfc_resolve_stat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED,
- gfc_expr *a ATTRIBUTE_UNUSED)
+gfc_resolve_stat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED, gfc_expr *a)
{
f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+ f->ts.kind = a->ts.kind;
f->value.function.name = gfc_get_string (PREFIX ("stat_i%d"), f->ts.kind);
}
void
-gfc_resolve_lstat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED,
- gfc_expr *a ATTRIBUTE_UNUSED)
+gfc_resolve_lstat (gfc_expr *f, gfc_expr *n ATTRIBUTE_UNUSED, gfc_expr *a)
{
f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+ f->ts.kind = a->ts.kind;
f->value.function.name = gfc_get_string (PREFIX ("lstat_i%d"), f->ts.kind);
}
void
-gfc_resolve_fstat (gfc_expr *f, gfc_expr *n, gfc_expr *a ATTRIBUTE_UNUSED)
+gfc_resolve_fstat (gfc_expr *f, gfc_expr *n, gfc_expr *a)
{
f->ts.type = BT_INTEGER;
- f->ts.kind = gfc_default_integer_kind;
+ f->ts.kind = a->ts.kind;
if (n->ts.kind != f->ts.kind)
gfc_convert_type (n, &f->ts, 2);
@@ -4159,7 +4157,9 @@ void
gfc_resolve_stat_sub (gfc_code *c)
{
const char *name;
- name = gfc_get_string (PREFIX ("stat_i%d_sub"), gfc_default_integer_kind);
+ gfc_typespec *ts;
+ ts = &c->ext.actual->next->expr->ts;
+ name = gfc_get_string (PREFIX ("stat_i%d_sub"), ts->kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
@@ -4168,7 +4168,9 @@ void
gfc_resolve_lstat_sub (gfc_code *c)
{
const char *name;
- name = gfc_get_string (PREFIX ("lstat_i%d_sub"), gfc_default_integer_kind);
+ gfc_typespec *ts;
+ ts = &c->ext.actual->next->expr->ts;
+ name = gfc_get_string (PREFIX ("lstat_i%d_sub"), ts->kind);
c->resolved_sym = gfc_get_intrinsic_sub_symbol (name);
}
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index b077cee86a3..f03144f9427 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -225,6 +225,12 @@ tree gfor_fndecl_iargc;
tree gfor_fndecl_kill;
tree gfor_fndecl_kill_sub;
tree gfor_fndecl_is_contiguous0;
+tree gfor_fndecl_fstat_i4_sub;
+tree gfor_fndecl_fstat_i8_sub;
+tree gfor_fndecl_lstat_i4_sub;
+tree gfor_fndecl_lstat_i8_sub;
+tree gfor_fndecl_stat_i4_sub;
+tree gfor_fndecl_stat_i8_sub;
/* Intrinsic functions implemented in Fortran. */
@@ -3910,6 +3916,34 @@ gfc_build_intrinsic_function_decls (void)
gfc_int4_type_node, 1, pvoid_type_node);
DECL_PURE_P (gfor_fndecl_is_contiguous0) = 1;
TREE_NOTHROW (gfor_fndecl_is_contiguous0) = 1;
+
+ gfor_fndecl_fstat_i4_sub = gfc_build_library_function_decl (
+ get_identifier (PREFIX ("fstat_i4_sub")), void_type_node,
+ 3, gfc_pint4_type_node, gfc_pint4_type_node, gfc_pint4_type_node);
+
+ gfor_fndecl_fstat_i8_sub = gfc_build_library_function_decl (
+ get_identifier (PREFIX ("fstat_i8_sub")), void_type_node,
+ 3, gfc_pint8_type_node, gfc_pint8_type_node, gfc_pint8_type_node);
+
+ gfor_fndecl_lstat_i4_sub = gfc_build_library_function_decl (
+ get_identifier (PREFIX ("lstat_i4_sub")), void_type_node,
+ 4, pchar_type_node, gfc_pint4_type_node, gfc_pint4_type_node,
+ gfc_charlen_type_node);
+
+ gfor_fndecl_lstat_i8_sub = gfc_build_library_function_decl (
+ get_identifier (PREFIX ("lstat_i8_sub")), void_type_node,
+ 4, pchar_type_node, gfc_pint8_type_node, gfc_pint8_type_node,
+ gfc_charlen_type_node);
+
+ gfor_fndecl_stat_i4_sub = gfc_build_library_function_decl (
+ get_identifier (PREFIX ("stat_i4_sub")), void_type_node,
+ 4, pchar_type_node, gfc_pint4_type_node, gfc_pint4_type_node,
+ gfc_charlen_type_node);
+
+ gfor_fndecl_stat_i8_sub = gfc_build_library_function_decl (
+ get_identifier (PREFIX ("stat_i8_sub")), void_type_node,
+ 4, pchar_type_node, gfc_pint8_type_node, gfc_pint8_type_node,
+ gfc_charlen_type_node);
}
diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index e720b42355f..b6691f58bee 100644
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -5871,6 +5871,125 @@ gfc_conv_intrinsic_findloc (gfc_se *se, gfc_expr *expr)
}
+/* Emit code for fstat, lstat and stat intrinsic subroutines. */
+
+static tree
+conv_intrinsic_fstat_lstat_stat_sub (gfc_code *code)
+{
+ stmtblock_t block;
+ gfc_se se, se_stat;
+ tree unit;
+ tree name, slen;
+ tree vals;
+ tree arg3 = NULL_TREE;
+ tree stat = NULL_TREE ;
+ tree present = NULL_TREE;
+ tree tmp;
+ int kind;
+
+ gfc_init_block (&block);
+ gfc_init_se (&se, NULL);
+
+ switch (code->resolved_isym->id)
+ {
+ case GFC_ISYM_FSTAT:
+ /* Deal with the UNIT argument. */
+ gfc_conv_expr (&se, code->ext.actual->expr);
+ gfc_add_block_to_block (&block, &se.pre);
+ unit = gfc_evaluate_now (se.expr, &block);
+ unit = gfc_build_addr_expr (NULL_TREE, unit);
+ gfc_add_block_to_block (&block, &se.post);
+ break;
+
+ case GFC_ISYM_LSTAT:
+ case GFC_ISYM_STAT:
+ /* Deal with the NAME argument. */
+ gfc_conv_expr (&se, code->ext.actual->expr);
+ gfc_conv_string_parameter (&se);
+ gfc_add_block_to_block (&block, &se.pre);
+ name = se.expr;
+ slen = se.string_length;
+ gfc_add_block_to_block (&block, &se.post);
+ break;
+
+ default:
+ gcc_unreachable ();
+ }
+
+ /* Deal with the VALUES argument. */
+ gfc_init_se (&se, NULL);
+ gfc_conv_expr_descriptor (&se, code->ext.actual->next->expr);
+ vals = gfc_build_addr_expr (NULL_TREE, se.expr);
+ gfc_add_block_to_block (&block, &se.pre);
+ gfc_add_block_to_block (&block, &se.post);
+ kind = code->ext.actual->next->expr->ts.kind;
+
+ /* Deal with an optional STATUS. */
+ if (code->ext.actual->next->next->expr)
+ {
+ gfc_init_se (&se_stat, NULL);
+ gfc_conv_expr (&se_stat, code->ext.actual->next->next->expr);
+ stat = gfc_create_var (gfc_get_int_type (kind), "_stat");
+ arg3 = gfc_build_addr_expr (NULL_TREE, stat);
+
+ /* Handle case of status being an optional dummy. */
+ gfc_symbol *sym = code->ext.actual->next->next->expr->symtree->n.sym;
+ if (sym->attr.dummy && sym->attr.optional)
+ {
+ present = gfc_conv_expr_present (sym);
+ arg3 = fold_build3_loc (input_location, COND_EXPR,
+ TREE_TYPE (arg3), present, arg3,
+ fold_convert (TREE_TYPE (arg3),
+ null_pointer_node));
+ }
+ }
+
+ /* Call library function depending on KIND of VALUES argument. */
+ switch (code->resolved_isym->id)
+ {
+ case GFC_ISYM_FSTAT:
+ tmp = (kind == 4 ? gfor_fndecl_fstat_i4_sub : gfor_fndecl_fstat_i8_sub);
+ break;
+ case GFC_ISYM_LSTAT:
+ tmp = (kind == 4 ? gfor_fndecl_lstat_i4_sub : gfor_fndecl_lstat_i8_sub);
+ break;
+ case GFC_ISYM_STAT:
+ tmp = (kind == 4 ? gfor_fndecl_stat_i4_sub : gfor_fndecl_stat_i8_sub);
+ break;
+ default:
+ gcc_unreachable ();
+ }
+
+ if (code->resolved_isym->id == GFC_ISYM_FSTAT)
+ tmp = build_call_expr_loc (input_location, tmp, 3, unit, vals,
+ stat ? arg3 : null_pointer_node);
+ else
+ tmp = build_call_expr_loc (input_location, tmp, 4, name, vals,
+ stat ? arg3 : null_pointer_node, slen);
+ gfc_add_expr_to_block (&block, tmp);
+
+ /* Handle kind conversion of status. */
+ if (stat && stat != se_stat.expr)
+ {
+ stmtblock_t block2;
+
+ gfc_init_block (&block2);
+ gfc_add_modify (&block2, se_stat.expr,
+ fold_convert (TREE_TYPE (se_stat.expr), stat));
+
+ if (present)
+ {
+ tmp = build3_v (COND_EXPR, present, gfc_finish_block (&block2),
+ build_empty_stmt (input_location));
+ gfc_add_expr_to_block (&block, tmp);
+ }
+ else
+ gfc_add_block_to_block (&block, &block2);
+ }
+
+ return gfc_finish_block (&block);
+}
+
/* Emit code for minval or maxval intrinsic. There are many different cases
we need to handle. For performance reasons we sometimes create two
loops instead of one, where the second one is much simpler.
@@ -13352,6 +13471,12 @@ gfc_conv_intrinsic_subroutine (gfc_code *code)
res = conv_intrinsic_free (code);
break;
+ case GFC_ISYM_FSTAT:
+ case GFC_ISYM_LSTAT:
+ case GFC_ISYM_STAT:
+ res = conv_intrinsic_fstat_lstat_stat_sub (code);
+ break;
+
case GFC_ISYM_RANDOM_INIT:
res = conv_intrinsic_random_init (code);
break;
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 55541845a6d..1d04b22abc8 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -983,6 +983,12 @@ extern GTY(()) tree gfor_fndecl_iargc;
extern GTY(()) tree gfor_fndecl_kill;
extern GTY(()) tree gfor_fndecl_kill_sub;
extern GTY(()) tree gfor_fndecl_is_contiguous0;
+extern GTY(()) tree gfor_fndecl_fstat_i4_sub;
+extern GTY(()) tree gfor_fndecl_fstat_i8_sub;
+extern GTY(()) tree gfor_fndecl_lstat_i4_sub;
+extern GTY(()) tree gfor_fndecl_lstat_i8_sub;
+extern GTY(()) tree gfor_fndecl_stat_i4_sub;
+extern GTY(()) tree gfor_fndecl_stat_i8_sub;
/* Implemented in Fortran. */
extern GTY(()) tree gfor_fndecl_sc_kind;
diff --git a/gcc/testsuite/gfortran.dg/stat_3.f90 b/gcc/testsuite/gfortran.dg/stat_3.f90
index 93ec1836a9a..9bfff1eeb7d 100644
--- a/gcc/testsuite/gfortran.dg/stat_3.f90
+++ b/gcc/testsuite/gfortran.dg/stat_3.f90
@@ -44,3 +44,16 @@ subroutine sub2 ()
call lstat (name, status=perr, values= pbuf)
call fstat (unit, status=perr, values= pbuf)
end
+
+subroutine sub3 ()
+ implicit none
+ integer(1) :: ierr1, unit1 = 10
+ integer(2) :: buff2(13)
+ integer(4) :: buff4(13)
+ integer(8) :: buff8(13)
+ character(len=32) :: name = "/etc/passwd"
+ ierr1 = stat (name,values=buff2) ! { dg-error "with kind 2" }
+ call fstat (unit1, values=buff2) ! { dg-error "with kind 2" }
+ call fstat (unit1, values=buff4, status=ierr1) ! { dg-error "at least four" }
+ call lstat (name, values=buff8, status=ierr1) ! { dg-error "at least four" }
+end
diff --git a/gcc/testsuite/gfortran.dg/stat_4.f90 b/gcc/testsuite/gfortran.dg/stat_4.f90
new file mode 100644
index 00000000000..c2d36ffc819
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/stat_4.f90
@@ -0,0 +1,94 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-original" }
+! PR fortran/82480 - make STAT/LSTAT/FSTAT generic
+
+subroutine fstat_sub_wrapper (unit, values8, status, opt_status4, opt_status8)
+ implicit none
+ integer(1), intent(in) :: unit
+ integer(8), intent(out) :: values8(:)
+ integer(2), intent(out) :: status
+ integer(4), intent(out), optional :: opt_status4
+ integer(8), intent(out), optional :: opt_status8
+ call fstat (unit, values8, status)
+ call fstat (unit, values8, opt_status4)
+ call fstat (unit, values8, opt_status8)
+end
+
+subroutine stat_sub_wrapper (name, values4, status, opt_status4, opt_status8)
+ implicit none
+ character(*), intent(in) :: name
+ integer(4), intent(out) :: values4(:)
+ integer(2), intent(out) :: status
+ integer(4), intent(out), optional :: opt_status4
+ integer(8), intent(out), optional :: opt_status8
+ call stat (name, values4, status)
+ call lstat (name, values4, status)
+ call stat (name, values4, opt_status4)
+ call lstat (name, values4, opt_status4)
+ call stat (name, values4, opt_status8)
+ call lstat (name, values4, opt_status8)
+end
+
+subroutine sub1 ()
+ implicit none
+ character(len=32) :: name = "/etc/passwd"
+ integer(1) :: unit1 = 10
+ integer(4) :: unit4 = 10, buff4(13)
+ integer(8) :: unit8 = 10, buff8(13)
+ integer :: ierr
+ ierr = fstat (unit1, values=buff4)
+ ierr = fstat (unit1, values=buff8)
+ ierr = fstat (unit4, values=buff4)
+ ierr = fstat (unit4, values=buff8)
+ ierr = fstat (unit8, values=buff4)
+ ierr = fstat (unit8, values=buff8)
+ ierr = stat (name, values=buff4)
+ ierr = stat (name, values=buff8)
+ ierr = lstat (name, values=buff4)
+ ierr = lstat (name, values=buff8)
+end
+
+subroutine sub2 ()
+ implicit none
+ integer(2) :: ierr2, unit2 = 10
+ integer(4) :: ierr4, unit4 = 10, buff4(13)
+ integer(8) :: ierr8, unit8 = 10, buff8(13)
+ character(len=32) :: name = "/etc/passwd"
+ call fstat (unit2, values=buff4)
+ call fstat (unit2, values=buff8)
+ call fstat (unit4, values=buff4)
+ call fstat (unit4, values=buff8)
+ call fstat (unit8, values=buff4)
+ call fstat (unit8, values=buff8)
+ call stat (name, values=buff4)
+ call lstat (name, values=buff4)
+ call stat (name, values=buff8)
+ call lstat (name, values=buff8)
+ call fstat (unit4, values=buff4, status=ierr2)
+ call fstat (unit4, values=buff4, status=ierr4)
+ call fstat (unit4, values=buff4, status=ierr8)
+ call fstat (unit4, values=buff8, status=ierr2)
+ call fstat (unit4, values=buff8, status=ierr4)
+ call fstat (unit4, values=buff8, status=ierr8)
+ call stat (name, values=buff4, status=ierr4)
+ call lstat (name, values=buff4, status=ierr4)
+ call stat (name, values=buff4, status=ierr8)
+ call lstat (name, values=buff4, status=ierr8)
+ call stat (name, values=buff8, status=ierr4)
+ call lstat (name, values=buff8, status=ierr4)
+end
+
+! { dg-final { scan-tree-dump-times "_gfortran_fstat_i4_sub" 6 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_lstat_i4_sub" 6 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_stat_i4_sub" 6 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_fstat_i8_sub" 9 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_lstat_i8_sub" 2 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_stat_i8_sub" 2 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_fstat_i4 " 3 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_fstat_i8 " 3 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_lstat_i4 " 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_lstat_i8 " 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_stat_i4 " 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_stat_i8 " 1 "original" } }
+! { dg-final { scan-tree-dump-times "opt_status4" 11 "original" } }
+! { dg-final { scan-tree-dump-times "opt_status8" 11 "original" } }
--
2.51.0
