procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fortran: reject invalid non-constant pointer initialization targets

Browse source 
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.
This commit is contained in:
Harald Anlauf 2022-01-09 22:08:14 +01:00
parent c1c17a43e1
commit 2e63128306
2 changed files with 57 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

34
gcc/fortran/expr.c
View file

@ -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
{

23
gcc/testsuite/gfortran.dg/pr101762.f90 Normal file
View file

@ -0,0 +1,23 @@
! { dg-do compile }
! PR fortran/101762 - ICE on non-constant pointer initialization targets
! Contributed by G.Steinmetz
program p
integer, target :: a(3) = [7, 8, 9]
integer, pointer :: x => a(3)
integer, pointer :: y => a(n()) ! { dg-error "constant expression" }
integer, pointer :: z(:) => a(:n()) ! { dg-error "constant expression" }
character(7), target :: c = "abcdefg"
character(3), pointer :: c0 => c(2:4)
character(3), pointer :: c1 => c(m():) ! { dg-error "constant expression" }
character(3), pointer :: c2 => c(:m()) ! { dg-error "constant expression" }
print *, x, y
contains
pure integer function k ()
k = 2
end function k
subroutine s ()
integer, pointer :: yy => a(k()) ! { dg-error "constant expression" }
print *, yy
end subroutine s
end