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

Fortran: extend check for array arguments and reject CLASS array elements.

Browse source 
gcc/fortran/ChangeLog:

	PR fortran/101536
	* check.c (array_check): Adjust check for the case of CLASS
	arrays.

gcc/testsuite/ChangeLog:

	PR fortran/101536
	* gfortran.dg/pr101536.f90: New test.
This commit is contained in:
Harald Anlauf 2021-07-23 21:00:10 +02:00
parent 8408d34570
commit e314cfc371
2 changed files with 34 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gcc/fortran/check.c
View file

@ -731,12 +731,11 @@ logical_array_check (gfc_expr *array, int n)
static bool
array_check (gfc_expr *e, int n)
{
if (e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
if (e->rank != 0 && e->ts.type == BT_CLASS && gfc_expr_attr (e).class_ok
&& CLASS_DATA (e)->attr.dimension
&& CLASS_DATA (e)->as->rank)
{
gfc_add_class_array_ref (e);
return true;
}
if (e->rank != 0 && e->ts.type != BT_PROCEDURE)

33
gcc/testsuite/gfortran.dg/pr101536.f90 Normal file
View file

@ -0,0 +1,33 @@
! { dg-do compile }
! PR fortran/101536 - ICE in gfc_conv_expr_descriptor
program p
type s
class(*), allocatable :: c
end type
type t
class(*), allocatable :: c(:)
end type t
type u
integer :: c(2)
end type
type(t) :: x
x%c = [1,2,3,4]
! print *, size (x)
print *, size (x%c)
print *, size (x%c(1)) ! { dg-error "must be an array" }
contains
integer function f(x, y, z)
class(t), allocatable :: x(:)
class(u) :: y(:)
class(s) :: z
f = size (x)
f = size (x(1)) ! { dg-error "must be an array" }
f = size (y)
f = size (y%c(1))
f = size (y(2)%c)
f = size (y(2)%c(1)) ! { dg-error "must be an array" }
f = size (z) ! { dg-error "must be an array" }
f = size (z% c) ! { dg-error "must be an array" }
end
end