aboutsummaryrefslogtreecommitdiff
path: root/gcc/fortran/expr.c
diff options
context:
space:
mode:
authorHarald Anlauf <anlauf@gmx.de>2022-01-09 22:08:14 +0100
committerHarald Anlauf <anlauf@gmx.de>2022-01-09 22:08:14 +0100
commit2e63128306ff93d8f53119137dd6c28b2defac94 (patch)
tree948ad63e7807d7e3874dddb39ff9e15b6bc33641 /gcc/fortran/expr.c
parentc1c17a43e172ebc28f2cd247f6e83c5fdbc6219f (diff)
downloadgcc-2e63128306ff93d8f53119137dd6c28b2defac94.zip
gcc-2e63128306ff93d8f53119137dd6c28b2defac94.tar.gz
gcc-2e63128306ff93d8f53119137dd6c28b2defac94.tar.bz2
Fortran: reject invalid non-constant pointer initialization targets
gcc/fortran/ChangeLog: PR fortran/101762 * expr.c (gfc_check_pointer_assign): For pointer initialization targets, check that subscripts and substring indices in specifications are constant expressions. gcc/testsuite/ChangeLog: PR fortran/101762 * gfortran.dg/pr101762.f90: New test.
Diffstat (limited to 'gcc/fortran/expr.c')
-rw-r--r--gcc/fortran/expr.c34
1 files changed, 34 insertions, 0 deletions
diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index 96a2cd7..a87686d 100644
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -4343,6 +4343,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
{
gfc_symbol *sym;
bool target;
+ gfc_ref *ref;
if (gfc_is_size_zero_array (rvalue))
{
@@ -4372,6 +4373,39 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue,
&rvalue->where);
return false;
}
+
+ for (ref = rvalue->ref; ref; ref = ref->next)
+ {
+ switch (ref->type)
+ {
+ case REF_ARRAY:
+ for (int n = 0; n < ref->u.ar.dimen; n++)
+ if (!gfc_is_constant_expr (ref->u.ar.start[n])
+ || !gfc_is_constant_expr (ref->u.ar.end[n])
+ || !gfc_is_constant_expr (ref->u.ar.stride[n]))
+ {
+ gfc_error ("Every subscript of target specification "
+ "at %L must be a constant expression",
+ &ref->u.ar.where);
+ return false;
+ }
+ break;
+
+ case REF_SUBSTRING:
+ if (!gfc_is_constant_expr (ref->u.ss.start)
+ || !gfc_is_constant_expr (ref->u.ss.end))
+ {
+ gfc_error ("Substring starting and ending points of target "
+ "specification at %L must be constant expressions",
+ &ref->u.ss.start->where);
+ return false;
+ }
+ break;
+
+ default:
+ break;
+ }
+ }
}
else
{