OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/66366 ([OOP] ICE on invalid with non-allocatable CLASS variable)

Browse Source 
2016-11-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/66366
	* resolve.c (resolve_component): Move check for C437
	to ...
	* decl.c (build_struct): ... here. Fix indentation.

2016-11-13  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/66366
	* gfortran.dg/class_57.f90: Changed error message.
	* gfortran.dg/class_60.f90: New test.

From-SVN: r242351
This commit is contained in:
Janus Weil 2016-11-13 10:56:10 +01:00
parent 559f2bbc36
commit 9cbf867310
6 changed files with 58 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View File

@ -1,3 +1,10 @@
2016-11-13 Janus Weil <janus@gcc.gnu.org>
PR fortran/66366
* resolve.c (resolve_component): Move check for C437
to ...
* decl.c (build_struct): ... here. Fix indentation.
2016-11-12 Janus Weil <janus@gcc.gnu.org>
PR fortran/77501

13
gcc/fortran/decl.c
View File

@ -1866,9 +1866,18 @@ build_struct (const char *name, gfc_charlen *cl, gfc_expr **init,
}
else if (current_attr.allocatable == 0)
{
gfc_error ("Component at %C must have the POINTER attribute");
return false;
gfc_error ("Component at %C must have the POINTER attribute");
return false;
}
}
/* F03:C437. */
if (current_ts.type == BT_CLASS
&& !(current_attr.pointer || current_attr.allocatable))
{
gfc_error ("Component %qs with CLASS at %C must be allocatable "
"or pointer", name);
return false;
}
if (gfc_current_block ()->attr.pointer && (*as)->rank != 0)

13
gcc/fortran/resolve.c
View File

@ -13587,19 +13587,6 @@ resolve_component (gfc_component *c, gfc_symbol *sym)
return false;
}
/* C437. */
if (c->ts.type == BT_CLASS && c->attr.flavor != FL_PROCEDURE
&& (!c->attr.class_ok
|| !(CLASS_DATA (c)->attr.class_pointer
|| CLASS_DATA (c)->attr.allocatable)))
{
gfc_error ("Component %qs with CLASS at %L must be allocatable "
"or pointer", c->name, &c->loc);
/* Prevent a recurrence of the error. */
c->ts.type = BT_UNKNOWN;
return false;
}
/* If an allocatable component derived type is of the same type as
the enclosing derived type, we need a vtable generating so that
the __deallocate procedure is created. */

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2016-11-13 Janus Weil <janus@gcc.gnu.org>
PR fortran/66366
* gfortran.dg/class_57.f90: Changed error message.
* gfortran.dg/class_60.f90: New test.
2016-11-12 David Edelsohn <dje.gcc@gmail.com>
* g++.dg/pr78112.C: XFAIL AIX.

2
gcc/testsuite/gfortran.dg/class_57.f90
View File

@ -18,7 +18,7 @@ contains
function pc(pd)
type(p) :: pc
class(d), intent(in), target :: pd
pc%cc => pd ! { dg-error "Non-POINTER in pointer association context" }
pc%cc => pd ! { dg-error "is not a member of" }
end function
end

33
gcc/testsuite/gfortran.dg/class_60.f90 Normal file
View File

@ -0,0 +1,33 @@
! { dg-do compile }
!
! PR 66366: [OOP] ICE on invalid with non-allocatable CLASS variable
!
! Contributed by Andrew Benson <abensonca@gmail.com>
module bug
type :: t1d
contains
procedure :: interpolate => interp
end type t1d
type :: tff
class(t1d) :: transfer ! { dg-error "must be allocatable or pointer" }
end type tff
contains
double precision function interp(self)
implicit none
class(t1d), intent(inout) :: self
return
end function interp
double precision function fvb(self)
implicit none
class(tff), intent(inout) :: self
fvb=self%transfer%interpolate() ! { dg-error "is not a member of" }
return
end function fvb
end module bug