===================================================================
@@ -31,7 +31,7 @@ TYPE, EXTENDS(middle) :: bottom
CONTAINS
! useful proc to satisfy deferred procedure in top. Because we've
! extended middle we wouldn't get told off if we forgot this.
- PROCEDURE :: proc_a => bottom_a
+ PROCEDURE :: proc_a => bottom_a ! { dg-error "must be a module procedure" }
! calls middle%proc_b and then provides extra behaviour
PROCEDURE :: proc_b => bottom_b
! calls top_c and then provides extra behaviour
===================================================================
@@ -950,6 +950,9 @@ resolve_contained_functions (gfc_namespace *ns)
}
+static gfc_try resolve_fl_derived0 (gfc_symbol *sym);
+
+
/* Resolve all of the elements of a structure constructor and make sure that
the types are correct. The 'init' flag indicates that the given
constructor is an initializer. */
@@ -965,7 +968,7 @@ resolve_structure_cons (gfc_expr *expr, int init)
t = SUCCESS;
if (expr->ts.type == BT_DERIVED)
- resolve_symbol (expr->ts.u.derived);
+ resolve_fl_derived0 (expr->ts.u.derived);
cons = gfc_constructor_first (expr->value.constructor);
/* A constructor may have references if it is the result of substituting a
@@ -11361,9 +11364,14 @@ static gfc_try
resolve_typebound_procedures (gfc_symbol* derived)
{
int op;
+ gfc_symbol* super_type;
if (!derived->f2k_derived || !derived->f2k_derived->tb_sym_root)
return SUCCESS;
+
+ super_type = gfc_get_derived_super_type (derived);
+ if (super_type)
+ resolve_typebound_procedures (super_type);
resolve_bindings_derived = derived;
resolve_bindings_result = SUCCESS;
@@ -11475,28 +11483,17 @@ ensure_not_abstract (gfc_symbol* sub, gfc_symbol*
}
-/* Resolve the components of a derived type. */
+/* Resolve the components of a derived type. This does not have to wait until
+ resolution stage, but can be done as soon as the dt declaration has been
+ parsed. */
static gfc_try
-resolve_fl_derived (gfc_symbol *sym)
+resolve_fl_derived0 (gfc_symbol *sym)
{
gfc_symbol* super_type;
gfc_component *c;
super_type = gfc_get_derived_super_type (sym);
-
- if (sym->attr.is_class && sym->ts.u.derived == NULL)
- {
- /* Fix up incomplete CLASS symbols. */
- gfc_component *data = gfc_find_component (sym, "_data", true, true);
- gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
- if (vptr->ts.u.derived == NULL)
- {
- gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
- gcc_assert (vtab);
- vptr->ts.u.derived = vtab->ts.u.derived;
- }
- }
/* F2008, C432. */
if (super_type && sym->attr.coarray_comp && !super_type->attr.coarray_comp)
@@ -11508,7 +11505,7 @@ static gfc_try
}
/* Ensure the extended type gets resolved before we do. */
- if (super_type && resolve_fl_derived (super_type) == FAILURE)
+ if (super_type && resolve_fl_derived0 (super_type) == FAILURE)
return FAILURE;
/* An ABSTRACT type must be extensible. */
@@ -11861,14 +11858,6 @@ static gfc_try
return FAILURE;
}
- /* Resolve the type-bound procedures. */
- if (resolve_typebound_procedures (sym) == FAILURE)
- return FAILURE;
-
- /* Resolve the finalizer procedures. */
- if (gfc_resolve_finalizers (sym) == FAILURE)
- return FAILURE;
-
/* If this is a non-ABSTRACT type extending an ABSTRACT one, ensure that
all DEFERRED bindings are overridden. */
if (super_type && super_type->attr.abstract && !sym->attr.abstract
@@ -11883,7 +11872,43 @@ static gfc_try
}
+/* The following procedure does the full resolution of a derived type,
+ including resolution of all type-bound procedures (if present). In contrast
+ to 'resolve_fl_derived0' this can only be done after the module has been
+ parsed completely. */
+
static gfc_try
+resolve_fl_derived (gfc_symbol *sym)
+{
+ if (sym->attr.is_class && sym->ts.u.derived == NULL)
+ {
+ /* Fix up incomplete CLASS symbols. */
+ gfc_component *data = gfc_find_component (sym, "_data", true, true);
+ gfc_component *vptr = gfc_find_component (sym, "_vptr", true, true);
+ if (vptr->ts.u.derived == NULL)
+ {
+ gfc_symbol *vtab = gfc_find_derived_vtab (data->ts.u.derived);
+ gcc_assert (vtab);
+ vptr->ts.u.derived = vtab->ts.u.derived;
+ }
+ }
+
+ if (resolve_fl_derived0 (sym) == FAILURE)
+ return FAILURE;
+
+ /* Resolve the type-bound procedures. */
+ if (resolve_typebound_procedures (sym) == FAILURE)
+ return FAILURE;
+
+ /* Resolve the finalizer procedures. */
+ if (gfc_resolve_finalizers (sym) == FAILURE)
+ return FAILURE;
+
+ return SUCCESS;
+}
+
+
+static gfc_try
resolve_fl_namelist (gfc_symbol *sym)
{
gfc_namelist *nl;
Hi all, the PR in the subject line contains several issues, and with the "duplicate save" part fixed, the attached patch takes care of the "missing type-bound procedure" regression (comment #6). The problem is the following: When parsing a structure constructor, we have to resolve the derived type first. However, this will also trigger the construction of the vtab for this type (if it has type-bound procedures), which in turn will be incomplete if we're in the middle of a module and the type-bound procedures have not been parsed fully. To solve this dilemma, I have split off from 'resolve_fl_derived' a part which only concerns the data components etc ('resolve_fl_derived0'). This can be called whenever we encounter a structure constructor. The full 'resolve_fl_derived' will call this split-off part and in addition resolve the typebound procedures, thereby constucting the vtab. The patch was regtested on x86_64-unknown-linux-gnu. Ok for trunk and 4.6? Cheers, Janus 2011-07-30 Janus Weil <janus@gcc.gnu.org> PR fortran/49112 * resolve.c (resolve_structure_cons): Don't do the full dt resolution, only call 'resolve_fl_derived0'. (resolve_typebound_procedures): Resolve typebound procedures of parent type. (resolve_fl_derived0): New function, which does a part of the work for 'resolve_fl_derived'. (resolve_fl_derived): Call 'resolve_fl_derived0' and do some additional things. 2011-07-30 Janus Weil <janus@gcc.gnu.org> PR fortran/49112 * gfortran.dg/abstract_type_6.f03: Modified. * gfortran.dg/typebound_proc_24.f03: New.