aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/fortran')
-rw-r--r--gcc/fortran/ChangeLog15
-rw-r--r--gcc/fortran/check.cc61
-rw-r--r--gcc/fortran/intrinsic.texi24
-rw-r--r--gcc/fortran/trans-array.cc12
4 files changed, 71 insertions, 41 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fb84921..9a5ffb9 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,18 @@
+2025-06-19 Mikael Morin <mikael@gcc.gnu.org>
+
+ PR fortran/120713
+ * trans-array.cc (gfc_trans_deferred_array): Statically
+ initialize deferred length variable for SAVEd character arrays.
+
+2025-06-18 Harald Anlauf <anlauf@gmx.de>
+
+ PR fortran/82480
+ * 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.
+
2025-06-16 Harald Anlauf <anlauf@gmx.de>
PR fortran/51961
diff --git a/gcc/fortran/check.cc b/gcc/fortran/check.cc
index c8904df..838d523 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/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi
index 5831995..3103da3 100644
--- 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/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9606131..3d27443 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -12067,8 +12067,16 @@ gfc_trans_deferred_array (gfc_symbol * sym, gfc_wrapped_block * block)
&& !INTEGER_CST_P (sym->ts.u.cl->backend_decl))
{
if (sym->ts.deferred && !sym->ts.u.cl->length && !sym->attr.dummy)
- gfc_add_modify (&init, sym->ts.u.cl->backend_decl,
- build_zero_cst (TREE_TYPE (sym->ts.u.cl->backend_decl)));
+ {
+ tree len_expr = sym->ts.u.cl->backend_decl;
+ tree init_val = build_zero_cst (TREE_TYPE (len_expr));
+ if (VAR_P (len_expr)
+ && sym->attr.save
+ && !DECL_INITIAL (len_expr))
+ DECL_INITIAL (len_expr) = init_val;
+ else
+ gfc_add_modify (&init, len_expr, init_val);
+ }
gfc_conv_string_length (sym->ts.u.cl, NULL, &init);
gfc_trans_vla_type_sizes (sym, &init);
generated by cgit v1.1 at 2025-06-20 17:02:42 +0000