Commit 9c63ca5a by Janus Weil

re PR fortran/50960 ([OOP] vtables not marked as constant)

2011-11-09  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/50960
	* class.c (gfc_find_derived_vtab): Make the vtab symbols FL_PARAMETER.
	* expr.c (gfc_simplify_expr): Prevent vtabs from being replaced with
	their value.
	* resolve.c (resolve_values): Use-associated symbols do not need to
	be resolved again.
	(resolve_fl_parameter): Make sure the symbol has a value.

From-SVN: r181199
parent 02c74373
2011-11-09 Janus Weil <janus@gcc.gnu.org>
PR fortran/50960
* class.c (gfc_find_derived_vtab): Make the vtab symbols FL_PARAMETER.
* expr.c (gfc_simplify_expr): Prevent vtabs from being replaced with
their value.
* resolve.c (resolve_values): Use-associated symbols do not need to
be resolved again.
(resolve_fl_parameter): Make sure the symbol has a value.
2011-11-08 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> 2011-11-08 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR fortran/38718 PR fortran/38718
......
...@@ -428,7 +428,7 @@ gfc_find_derived_vtab (gfc_symbol *derived) ...@@ -428,7 +428,7 @@ gfc_find_derived_vtab (gfc_symbol *derived)
{ {
gfc_get_symbol (name, ns, &vtab); gfc_get_symbol (name, ns, &vtab);
vtab->ts.type = BT_DERIVED; vtab->ts.type = BT_DERIVED;
if (gfc_add_flavor (&vtab->attr, FL_VARIABLE, NULL, if (gfc_add_flavor (&vtab->attr, FL_PARAMETER, NULL,
&gfc_current_locus) == FAILURE) &gfc_current_locus) == FAILURE)
goto cleanup; goto cleanup;
vtab->attr.target = 1; vtab->attr.target = 1;
......
...@@ -1883,7 +1883,8 @@ gfc_simplify_expr (gfc_expr *p, int type) ...@@ -1883,7 +1883,8 @@ gfc_simplify_expr (gfc_expr *p, int type)
initialization expression, or we want a subsection. */ initialization expression, or we want a subsection. */
if (p->symtree->n.sym->attr.flavor == FL_PARAMETER if (p->symtree->n.sym->attr.flavor == FL_PARAMETER
&& (gfc_init_expr_flag || p->ref && (gfc_init_expr_flag || p->ref
|| p->symtree->n.sym->value->expr_type != EXPR_ARRAY)) || p->symtree->n.sym->value->expr_type != EXPR_ARRAY)
&& !p->symtree->n.sym->attr.vtab)
{ {
if (simplify_parameter_variable (p, type) == FAILURE) if (simplify_parameter_variable (p, type) == FAILURE)
return FAILURE; return FAILURE;
......
...@@ -9514,7 +9514,7 @@ resolve_values (gfc_symbol *sym) ...@@ -9514,7 +9514,7 @@ resolve_values (gfc_symbol *sym)
{ {
gfc_try t; gfc_try t;
if (sym->value == NULL) if (sym->value == NULL || sym->attr.use_assoc)
return; return;
if (sym->value->expr_type == EXPR_STRUCTURE) if (sym->value->expr_type == EXPR_STRUCTURE)
...@@ -11982,7 +11982,7 @@ resolve_fl_parameter (gfc_symbol *sym) ...@@ -11982,7 +11982,7 @@ resolve_fl_parameter (gfc_symbol *sym)
/* Make sure the types of derived parameters are consistent. This /* Make sure the types of derived parameters are consistent. This
type checking is deferred until resolution because the type may type checking is deferred until resolution because the type may
refer to a derived type from the host. */ refer to a derived type from the host. */
if (sym->ts.type == BT_DERIVED if (sym->ts.type == BT_DERIVED && sym->value
&& !gfc_compare_types (&sym->ts, &sym->value->ts)) && !gfc_compare_types (&sym->ts, &sym->value->ts))
{ {
gfc_error ("Incompatible derived type in PARAMETER at %L", gfc_error ("Incompatible derived type in PARAMETER at %L",
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment