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

PR fortran/95980 - ICE in get_unique_type_string, at fortran/class.c:485

Browse source 
In SELECT TYPE, the argument may be an incorrectly specified unlimited
CLASS variable.  Avoid NULL pointer dereferences for clean error
recovery.

gcc/fortran/
	PR fortran/95980
	* class.c (gfc_add_component_ref, gfc_build_class_symbol):
	Add checks for NULL pointer dereference.
	* primary.c (gfc_variable_attr): Likewise.
	* resolve.c (resolve_variable, resolve_assoc_var)
	(resolve_fl_var_and_proc, resolve_fl_variable_derived)
	(resolve_symbol): Likewise.
This commit is contained in:
Harald Anlauf 2020-07-10 21:35:35 +02:00
parent 8a0b69f0b0
commit 70c884a4b8
4 changed files with 31 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/fortran/class.c
View file

@ -228,7 +228,7 @@ gfc_add_component_ref (gfc_expr *e, const char *name)
break;
tail = &((*tail)->next);
}
if (derived->components && derived->components->next &&
if (derived && derived->components && derived->components->next &&
derived->components->next->ts.type == BT_DERIVED &&
derived->components->next->ts.u.derived == NULL)
{
@ -663,6 +663,10 @@ gfc_build_class_symbol (gfc_typespec *ts, symbol_attribute *attr,
/* Determine the name of the encapsulating type. */
rank = !(*as) || (*as)->rank == -1 ? GFC_MAX_DIMENSIONS : (*as)->rank;
if (!ts->u.derived)
return false;
get_unique_hashed_string (tname, ts->u.derived);
if ((*as) && attr->allocatable)
name = xasprintf ("__class_%s_%d_%da", tname, rank, (*as)->corank);

2
gcc/fortran/primary.c
View file

@ -2597,7 +2597,7 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
sym = expr->symtree->n.sym;
attr = sym->attr;
if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
{
dimension = CLASS_DATA (sym)->attr.dimension;
codimension = CLASS_DATA (sym)->attr.codimension;

19
gcc/fortran/resolve.c
View file

@ -5571,6 +5571,7 @@ resolve_variable (gfc_expr *e)
}
/* TS 29113, C535b. */
else if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym)
&& CLASS_DATA (sym)->as
&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
|| (sym->ts.type != BT_CLASS && sym->as
@ -5618,6 +5619,7 @@ resolve_variable (gfc_expr *e)
/* TS 29113, C535b. */
if (((sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym)
&& CLASS_DATA (sym)->as
&& CLASS_DATA (sym)->as->type == AS_ASSUMED_RANK)
|| (sym->ts.type != BT_CLASS && sym->as
@ -9031,7 +9033,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
{
/* target's rank is 0, but the type of the sym is still array valued,
which has to be corrected. */
if (sym->ts.type == BT_CLASS
if (sym->ts.type == BT_CLASS && sym->ts.u.derived
&& CLASS_DATA (sym) && CLASS_DATA (sym)->as)
{
gfc_array_spec *as;
@ -12618,7 +12620,8 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
{
gfc_array_spec *as;
if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
if (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym))
as = CLASS_DATA (sym)->as;
else
as = sym->as;
@ -12628,7 +12631,8 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
{
bool pointer, allocatable, dimension;
if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
if (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym))
{
pointer = CLASS_DATA (sym)->attr.class_pointer;
allocatable = CLASS_DATA (sym)->attr.allocatable;
@ -12679,6 +12683,7 @@ resolve_fl_var_and_proc (gfc_symbol *sym, int mp_flag)
{
/* F03:C502. */
if (sym->attr.class_ok
&& sym->ts.u.derived
&& !sym->attr.select_type_temporary
&& !UNLIMITED_POLY (sym)
&& !gfc_type_is_extensible (CLASS_DATA (sym)->ts.u.derived))
@ -12717,7 +12722,8 @@ resolve_fl_variable_derived (gfc_symbol *sym, int no_init_flag)
associated by the presence of another class I symbol in the same
namespace. 14.6.1.3 of the standard and the discussion on
comp.lang.fortran. */
if (sym->ns != sym->ts.u.derived->ns
if (sym->ts.u.derived
&& sym->ns != sym->ts.u.derived->ns
&& !sym->ts.u.derived->attr.use_assoc
&& sym->ns->proc_name->attr.if_source != IFSRC_IFBODY)
{
@ -15348,7 +15354,7 @@ resolve_symbol (gfc_symbol *sym)
specification_expr = saved_specification_expr;
}
if (sym->ts.type == BT_CLASS && sym->attr.class_ok)
if (sym->ts.type == BT_CLASS && sym->attr.class_ok && sym->ts.u.derived)
{
as = CLASS_DATA (sym)->as;
class_attr = CLASS_DATA (sym)->attr;
@ -15749,6 +15755,7 @@ resolve_symbol (gfc_symbol *sym)
/* F2008, C525. */
if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.coarray_comp))
|| class_attr.codimension)
&& (sym->attr.result || sym->result == sym))
@ -15770,6 +15777,7 @@ resolve_symbol (gfc_symbol *sym)
/* F2008, C525. */
if (((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.coarray_comp))
&& (class_attr.codimension || class_attr.pointer || class_attr.dimension
|| class_attr.allocatable))
@ -15813,6 +15821,7 @@ resolve_symbol (gfc_symbol *sym)
/* F2008, C541. */
if ((((sym->ts.type == BT_DERIVED && sym->ts.u.derived->attr.coarray_comp)
|| (sym->ts.type == BT_CLASS && sym->attr.class_ok
&& sym->ts.u.derived && CLASS_DATA (sym)
&& CLASS_DATA (sym)->attr.coarray_comp))
|| (class_attr.codimension && class_attr.allocatable))
&& sym->attr.dummy && sym->attr.intent == INTENT_OUT)

11
gcc/testsuite/gfortran.dg/pr95980_2.f90 Normal file
View file

@ -0,0 +1,11 @@
! { dg-do compile }
! PR fortran/95980 - ICE in get_unique_type_string, at fortran/class.c:485
program p
type t
integer :: a
end type t
class(t) :: x ! { dg-error "must be dummy, allocatable or pointer" }
select type (y => x)
end select
end