Hi all,
the attached patch fixes PR 88009, an ICE-on-invalid regression caused
by one of my earlier commits. Apart from adding some extra checks to
avoid ICEs, it also uses the 'artificial' attribute to suppress bogus
errors (see comment #3) and does some minor cleanup in
resolve_fl_variable.
Regtests cleanly on x86_64-linux-gnu. Ok for trunk?
Cheers,
Janus
2019-01-05 Janus Weil <ja...@gcc.gnu.org>
PR fortran/88009
* class.c (gfc_find_derived_vtab): Mark the _final component as
artificial.
(find_intrinsic_vtab): Ditto. Also add an extra check to avoid
dereferencing a null pointer and adjust indentation.
* resolve.c (resolve_fl_variable): Add extra check to avoid
dereferencing a null pointer. Move variable declarations to local scope.
(resolve_fl_procedure): Add extra check to avoid dereferencing a null
pointer.
* symbol.c (check_conflict): Suppress errors for artificial symbols.
2019-01-05 Janus Weil <ja...@gcc.gnu.org>
PR fortran/88009
* gfortran.dg/blockdata_10.f90: New test case.
diff --git a/gcc/fortran/class.c b/gcc/fortran/class.c
index e55ab25882f..77f0fca9385 100644
--- a/gcc/fortran/class.c
+++ b/gcc/fortran/class.c
@@ -2466,6 +2466,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
generate_finalization_wrapper (derived, ns, tname, c);
@@ -2762,9 +2763,9 @@ find_intrinsic_vtab (gfc_typespec *ts)
/* This is elemental so that arrays are automatically
treated correctly by the scalarizer. */
copy->attr.elemental = 1;
- if (ns->proc_name->attr.flavor == FL_MODULE)
+ if (ns->proc_name && ns->proc_name->attr.flavor == FL_MODULE)
copy->module = ns->proc_name->name;
- gfc_set_sym_referenced (copy);
+ gfc_set_sym_referenced (copy);
/* Set up formal arguments. */
gfc_get_symbol ("src", sub_ns, &src);
src->ts.type = ts->type;
@@ -2798,6 +2799,7 @@ find_intrinsic_vtab (gfc_typespec *ts)
goto cleanup;
c->attr.proc_pointer = 1;
c->attr.access = ACCESS_PRIVATE;
+ c->attr.artificial = 1;
c->tb = XCNEW (gfc_typebound_proc);
c->tb->ppc = 1;
c->initializer = gfc_get_null_expr (NULL);
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index a498d19e411..beafe8da8bc 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -12274,13 +12274,8 @@ deferred_requirements (gfc_symbol *sym)
static bool
resolve_fl_variable (gfc_symbol *sym, int mp_flag)
{
- int no_init_flag, automatic_flag;
- gfc_expr *e;
- const char *auto_save_msg;
- bool saved_specification_expr;
-
- auto_save_msg = "Automatic object %qs at %L cannot have the "
- "SAVE attribute";
+ const char *auto_save_msg = "Automatic object %qs at %L cannot have the "
+ "SAVE attribute";
if (!resolve_fl_var_and_proc (sym, mp_flag))
return false;
@@ -12288,7 +12283,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
/* Set this flag to check that variables are parameters of all entries.
This check is effected by the call to gfc_resolve_expr through
is_non_constant_shape_array. */
- saved_specification_expr = specification_expr;
+ bool saved_specification_expr = specification_expr;
specification_expr = true;
if (sym->ns->proc_name
@@ -12315,6 +12310,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
{
/* Make sure that character string variables with assumed length are
dummy arguments. */
+ gfc_expr *e = NULL;
+
if (sym->ts.u.cl)
e = sym->ts.u.cl->length;
else
@@ -12364,7 +12361,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
apply_default_init_local (sym); /* Try to apply a default initialization. */
/* Determine if the symbol may not have an initializer. */
- no_init_flag = automatic_flag = 0;
+ int no_init_flag = 0, automatic_flag = 0;
if (sym->attr.allocatable || sym->attr.external || sym->attr.dummy
|| sym->attr.intrinsic || sym->attr.result)
no_init_flag = 1;
@@ -12494,7 +12491,7 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
module procedures are excluded by 2.2.3.3 - i.e., they are not
externally accessible and can access all the objects accessible in
the host. */
- if (!(sym->ns->parent
+ if (!(sym->ns->parent && sym->ns->parent->proc_name
&& sym->ns->parent->proc_name->attr.flavor == FL_MODULE)
&& gfc_check_symbol_access (sym))
{
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index a88e7c01df7..cd52c73031b 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -440,6 +440,9 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
const char *a1, *a2;
int standard;
+ if (attr->artificial)
+ return true;
+
if (where == NULL)
where = &gfc_current_locus;
diff --git a/gcc/testsuite/gfortran.dg/blockdata_10.f90 b/gcc/testsuite/gfortran.dg/blockdata_10.f90
new file mode 100644
index 00000000000..ce7ba25c269
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/blockdata_10.f90
@@ -0,0 +1,13 @@
+! { dg-do compile }
+!
+! PR 88009: [9 Regression] ICE in find_intrinsic_vtab, at fortran/class.c:2761
+!
+! Contributed by G. Steinmetz <gs...@t-online.de>
+
+module m
+ class(*), allocatable :: z
+end
+block data
+ use m
+ z = 'z' ! { dg-error "assignment statement is not allowed|Unexpected assignment statement" }
+end
