Hi All, The attached patch is amply described by the comments and the changelog. It also includes the fix for the memory leak in decl.cc, as promised some days ago.
OK for trunk? Regards Paul PS This leaves 89645 and 99065 as the only real blockers to PR87477. These will take a little while to fix. They come about because the type of the associate name is determined by that of a derived type function that hasn't been parsed at the time that component references are being parsed. If the order of the contained procedures is reversed, both test cases compile correctly. The fix will comprise matching the component name to the accessible derived types, while keeping track of all the references in case the match is ambiguous and has to be fixed up later.
Change107900.Logs
Description: Binary data
diff --git a/gcc/fortran/decl.cc b/gcc/fortran/decl.cc
index d09c8bc97d9..844345df77e 100644
--- a/gcc/fortran/decl.cc
+++ b/gcc/fortran/decl.cc
@@ -1086,6 +1086,8 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
p = gfc_copy_expr (*expr);
if (gfc_is_constant_expr (p) && gfc_simplify_expr (p, 1))
gfc_replace_expr (*expr, p);
+ else
+ gfc_free_expr (p);
if ((*expr)->expr_type == EXPR_FUNCTION)
{
diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc
index e6a4337c0d2..ab5f94e9f03 100644
--- a/gcc/fortran/trans-decl.cc
+++ b/gcc/fortran/trans-decl.cc
@@ -1875,6 +1875,13 @@ gfc_get_symbol_decl (gfc_symbol * sym)
&& !(sym->attr.use_assoc && !intrinsic_array_parameter)))
gfc_defer_symbol_init (sym);
+ /* Nullify so that select type doesn't fall over if the variable
+ is not associated. */
+ if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+ && sym->attr.flavor == FL_VARIABLE && !sym->assoc
+ && !sym->attr.dummy && CLASS_DATA (sym)->attr.class_pointer)
+ gfc_defer_symbol_init (sym);
+
if (sym->ts.type == BT_CHARACTER
&& sym->attr.allocatable
&& !sym->attr.dimension
@@ -1906,6 +1913,7 @@ gfc_get_symbol_decl (gfc_symbol * sym)
gcc_assert (!sym->value || sym->value->expr_type == EXPR_NULL);
}
+
gfc_finish_var_decl (decl, sym);
if (sym->ts.type == BT_CHARACTER)
@@ -4652,6 +4660,21 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
if (sym->assoc)
continue;
+ /* Nullify unlimited polymorphic variables so that they do not cause
+ segfaults in select type, when the selector is an intrinsic type. */
+ if (sym->ts.type == BT_CLASS && UNLIMITED_POLY (sym)
+ && sym->attr.flavor == FL_VARIABLE && !sym->assoc
+ && !sym->attr.dummy && CLASS_DATA (sym)->attr.class_pointer)
+ {
+ gfc_expr *lhs = gfc_lval_expr_from_sym (sym);
+ gfc_expr *rhs = gfc_get_null_expr (NULL);
+ tmp = gfc_trans_pointer_assignment (lhs, rhs);
+ gfc_init_block (&tmpblock);
+ gfc_add_expr_to_block (&tmpblock, tmp);
+ gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), NULL);
+ continue;
+ }
+
if (sym->ts.type == BT_DERIVED
&& sym->ts.u.derived
&& sym->ts.u.derived->attr.pdt_type)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 45a984b6bdb..eeae13998a3 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -10034,6 +10034,19 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
build_zero_cst (TREE_TYPE (lse.string_length)));
}
+ /* Unlimited polymorphic arrays, nullified in gfc_trans_deferred_vars,
+ arrive here as a scalar expr. Find the descriptor data field. */
+ if (expr1->ts.type == BT_CLASS && UNLIMITED_POLY (expr1)
+ && expr2->expr_type == EXPR_NULL
+ && !expr1->ref && !expr1->rank
+ && (CLASS_DATA (expr1)->attr.dimension
+ || CLASS_DATA (expr1)->attr.codimension))
+ {
+ lse.expr = gfc_get_class_from_expr (lse.expr);
+ lse.expr = gfc_class_data_get (lse.expr);
+ lse.expr = gfc_conv_descriptor_data_get (lse.expr);
+ }
+
gfc_add_modify (&block, lse.expr,
fold_convert (TREE_TYPE (lse.expr), rse.expr));
