diff options
author | Harald Anlauf <anlauf@gmx.de> | 2022-01-09 22:08:14 +0100 |
---|---|---|
committer | Harald Anlauf <anlauf@gmx.de> | 2022-01-09 22:08:14 +0100 |
commit | 2e63128306ff93d8f53119137dd6c28b2defac94 (patch) | |
tree | 948ad63e7807d7e3874dddb39ff9e15b6bc33641 /gcc/fortran/expr.c | |
parent | c1c17a43e172ebc28f2cd247f6e83c5fdbc6219f (diff) | |
download | gcc-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.c | 34 |
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 { |