mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-02-09 02:29:40 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/56386 ([F03] ICE with ASSOCIATE construct and an derived type array component)

Browse Source 
2018-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/56386
	PR fortran/58906
	PR fortran/77385
	PR fortran/80260
	PR fortran/82077
	* resolve.c (resolve_variable): Fix up expressions with array
	associate names, where the parser did not detect that this is
	array and there was no array part_ref in the expression.

2018-10-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/56386
	PR fortran/58906
	PR fortran/77385
	* gfortran.dg/associate_44.f90 : New test.

	PR fortran/80260
	* gfortran.dg/select_type_45.f90 : New test.

	PR fortran/82077
	* gfortran.dg/select_type_46.f90 : New test.

From-SVN: r265232
This commit is contained in:
Paul Thomas 2018-10-17 07:16:16 +00:00
parent 17d6b74d7f
commit ece6652651
6 changed files with 108 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gcc/fortran/ChangeLog
View File

@ -1,3 +1,14 @@
2018-10-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/56386
PR fortran/58906
PR fortran/77385
PR fortran/80260
PR fortran/82077
* resolve.c (resolve_variable): Fix up expressions with array
associate names, where the parser did not detect that this is
array and there was no array part_ref in the expression.
2018-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/67125

18
gcc/fortran/resolve.c
View File

@ -5436,6 +5436,24 @@ resolve_variable (gfc_expr *e)
gfc_fix_class_refs (e);
if (!sym->attr.dimension && e->ref && e->ref->type == REF_ARRAY)
return false;
else if (sym->attr.dimension && (!e->ref || e->ref->type != REF_ARRAY))
{
/* This can happen because the parser did not detect that the
associate name is an array and the expression had no array
part_ref. */
gfc_ref *ref = gfc_get_ref ();
ref->type = REF_ARRAY;
ref->u.ar = *gfc_get_array_ref();
ref->u.ar.type = AR_FULL;
if (sym->as)
{
ref->u.ar.as = sym->as;
ref->u.ar.dimen = sym->as->rank;
}
ref->next = e->ref;
e->ref = ref;
}
}
if (sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.generic)

13
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,16 @@
2018-10-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/56386
PR fortran/58906
PR fortran/77385
* gfortran.dg/associate_44.f90 : New test.
PR fortran/80260
* gfortran.dg/select_type_45.f90 : New test.
PR fortran/82077
* gfortran.dg/select_type_46.f90 : New test.
2018-10-16 Tobias Burnus <burnus@net-b.de>
PR fortran/67125

23
gcc/testsuite/gfortran.dg/associate_44.f90 Normal file
View File

@ -0,0 +1,23 @@
! { dg-do compile }
!
! Test the fix for PR56386
!
! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
!
subroutine CustomSolidBodies
implicit none
type inner
real :: elev
end type
type :: outer
type(inner),dimension(0) :: PrPoints
end type
type(outer) :: SB
associate (Prter=>SB%PrPoints)
PrTer%elev=0 ! ICE here
end associate
end subroutine CustomSolidBodies

22
gcc/testsuite/gfortran.dg/select_type_45.f90 Normal file
View File

@ -0,0 +1,22 @@
! { dg-do compile }
!
! Tests the fix for PR80260
!
! Contributed by Damian Rouson <damian@sourceryinstitute.org>
!
type foo
end type foo
type, extends(foo) :: bar
end type
contains
subroutine f(x)
class(foo) x(:,:)
select type(x)
class is (bar)
call g(x(1,:)) ! ICEd here.
end select
end subroutine
subroutine g(y)
class(bar) y(:)
end subroutine
end

21
gcc/testsuite/gfortran.dg/select_type_46.f90 Normal file
View File

@ -0,0 +1,21 @@
! { dg-do compile }
!
! Tests the fix for PR82077
!
! Contributed by Damian Rouson <damian@sourceryinstitute.org>
!
type parent
end type parent
type, extends(parent) :: child
end type
class(parent), allocatable :: foo(:,:)
allocate(child::foo(1,1))
select type(foo)
class is (child)
call gfortran7_ICE(foo(1,:)) ! ICEd here.
end select
contains
subroutine gfortran7_ICE(bar)
class(child) bar(:)
end subroutine
end